VBA Custom Property Access ?

[gedkins]

Hi,

I am trying to get a snippet of code for VBA that will utilize the Component2.GetModelDoc call. I need to modify/add custom properties of objects without making the actual object active or activated on the screen (it is in memory but not visible). I don't want to use the ActivatePart call. Anyone have a working code set they would be willing to send me?

TIA

G.

Guy Edkins
Managing Partner
Delta Group Ltd

gedkins@deltagl.com

http://www.deltagl.com

 

[TheTick]

The good news is that you're on the right track.

Custom properties are accessed via various get/set methods in the ModelDoc object.

One caveat regarding custom info: ModelDoc2.AddCustomInfo3 does not overwrite an existing property. If you want to add a custom info and overwrite, you may need to follow up with ModelDoc2.CustomInfo2.

Also, pay attention to the return values as listed in the API help. If the function calls for a boolean return value then you must use a boolean, and not a variant.

All this machinery making modern music can still be open-hearted.

 

[TheTick]

Public Type swPropParams 'used for writing custom info
pName As String
pType As Long
pValue As String
pSelected As Boolean
pConfig As String
End Type

Dim AllProps() As swPropParams
'=============================
'the above code is to document the structure
'of the "AllProps" array
'=============================

Private Sub DeleteProperties()
Dim I As Long
Dim BuBye As Boolean

If LBound(AllProps) = -1 Then Exit Sub
For I = LBound(AllProps) To UBound(AllProps)
If AllProps(I).pSelected Then
BuBye = Target.DeleteCustomInfo2(AllProps(I).pConfig, AllProps(I).pName)
End If
Next
End Sub

 

[TheTick]

'"Target" is SW ModelDoc2
'"swPropParams" type is the same as in previously
'posted code
'this code is from a VB form that copies selected properties
'from one file to another

Sub WriteProps()
Dim SelList As Variant 'property from lboProps.list
Dim PropList() As swPropParams
Dim TargetConfig As String
Dim i As Long
Dim TgtPropType As Long

TargetConfig = CStr(TargetConfigNames(cboTgtCfgs.ListIndex))

'eliminate unselected items from list
'from bottom to top
For i = (lboProps.ListCount - 1) To 0 Step -1
If lboProps.Selected(i) = False Then lboProps.RemoveItem (i)
Next
'move selected items to SelList
SelList = lboProps.List
'ubound(SelList,1) returns -1 if list is empty
If UBound(SelList, 1) = -1 Then Exit Sub
'move SelList to PropList
ReDim PropList(LBound(SelList) To UBound(SelList))
For i = LBound(SelList) To UBound(SelList)
PropList(i).pName = CStr(SelList(i, 0))
PropList(i).pType = ciTypeNum(CStr(SelList(i, 1)))
PropList(i).pValue = CStr(SelList(i, 2))
Next
'move PropList properties to Target file
'Target = swApp.ActivateDoc2(TargetFileName, True, Errorss)
For i = LBound(PropList) To UBound(PropList)
BoolStatus = Target.AddCustomInfo3(TargetConfig, PropList(i).pName, PropList(i).pType, PropList(i).pValue)
If chkOverwrite.Value Then
TgtPropType = Target.GetCustomInfoType3(TargetConfig, PropList(i).pName)
If TgtPropType = PropList(i).pType Then
Target.CustomInfo2(TargetConfig, PropList(i).pName) = PropList(i).pValue
Else
BoolStatus = Target.DeleteCustomInfo2(TargetConfig, PropList(i).pName)
BoolStatus = Target.AddCustomInfo3(TargetConfig, PropList(i).pName, PropList(i).pType, PropList(i).pValue)
End If
End If

Next
End Sub

 

[rocheey]

Well, I'll throw this into the mix ...

The following is a 2-Part post. This first post is just the description, and some sample calls. The second post is the actual Function itself.

Since we seem to get a lot of Custom Property API quastions here, I whipped up an 'ubder-routine' that will read AND write AND create custom properties, however many you want, each being a different data type, all at the same time, and do it all with one call.

It will also 'coerce' your passed data into the correct SW data type for the property; so if you arent sure if the prop is a string or a date, just send it a string, it will do the rest. However, dont pass the function an OBJECT, or hope it will turn an integer into a Date or something.

If you pass a Param name that does not exist, one will be created. However, if you dont pass a Specific SW Property data type (string,double,boolean,date) and instead pass a variant, you are getting stuck with a STRING.

It returns a variant safearray of values of each param name you passed. These values are what the values of the Custom properties were on exit from the routine. They *should* reflect what you sent it.

If you pass pure crap for parameters, it's just gonna exit the routine and return EMPTY, so you might wanna check the return for EMPTY before you start checking to see what the return values are.

The function expects to be passed 3 paramaters: The COMPONENT2 object, a safearray of one or more Config-specific parameters, and a safearray of one or more Config-specific values.

Since this function reads right from an assembly component, you want to have an assembly open, and one of the components selected.
'---- set up code starts here --------------
Sub Main
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim selmgr As SelectionMgr
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim comp As Component2

Set selmgr = Part.SelectionManager
Set comp = selmgr.GetSelectedObject3(1)

' now for the calls to the function
'
' set up 4 different data types for one call
Dim Prop1 As String: Prop1 = "test String"
Dim Prop2 As Date: Prop2 = Now
Dim Prop3 As Double: Prop3 = 3.14159265
Dim Prop4 As Variant: Prop4 = Empty

' Create an array of Config-specific proprty names (case unimportant)
' the last property we will use a default-supplied SW Custom property

PropNames = Array("Name1", "Name2", "Name3", "Description&quot
PropVals = Array(Prop1, Prop2, Prop3, Prop4)
retval = ComponentProps(comp, PropNames, PropVals)

' now check the return values
If Not (IsEmpty(retval)) Then
For I% = 0 To UBound(retval)
msg$ = msg$ & retval(I%) & vbCrLf
Next I%
MsgBox msg$, 32, "Return values"

End If

End Sub

 

[rocheey]

' Part 2 of 2 --- The actual function ---

Function ComponentProps(MyComponent As Component2, PropName As Variant, PropValue As Variant) As Variant
' gets or sets Custom Config Properties of passed Component Object

' Parameters:
' MyComponent: SW Object of COMPONENT Type.
' PropName: Variant safearray of One or More Property Names to change.
' If the property does not exist, it is created.
' Propvalue: Variant Safearray of One or More values to assign the Prop name.
' Passing a Value SETS the value, Passing an EMPTY will bypass
' the setting of the value (Just reads it).
' Returns: the values of each param name after the SET/GET, or returns EMPTY
' if any trouble getting to the properties


' set SW Custom Info data types into safearray
Dim swDataTypes As Variant
swDataTypes = Array(0&, 3&, 11&, 30&, 64&) ' Variant,Double,Boolean,String,Date

' Set values for related VB types into a safearray
Dim vbDataTypes As Variant
vbDataTypes = Array(12&, 5&, 11&, 8&, 7&)

Dim sngVal As Single, dblVal As Double, strVal As String
Dim boolVal As Boolean, dateVal As Date
Dim FieldValue As Variant


' do a little checking beforehand, to ensure passed params are OK:
If MyComponent Is Nothing Then Exit Function ' returns EMPTY
If IsEmpty(PropName) Or IsEmpty(PropValue) Then Exit Function
If UBound(PropName) <> UBound(PropValue) Then Exit Function

Dim tmpModel As ModelDoc2 ' stores the temp model
Dim ConfigName As String, ActiveCfgName As String
Dim success As Boolean

' define a safearray to hold return names for config-specific properties
Dim PropNames As Variant, NewVal As Variant

' Dim an array to hold the return values
ReDim RetValues(UBound(PropName)) As Variant

' store the config name
ConfigName = MyComponent.ReferencedConfiguration

' Grab the ModelDoc
Set tmpModel = MyComponent.GetModelDoc
' make sure we have the model before continuing
If tmpModel Is Nothing Then Exit Function


' ensure we have the active config for the component (not ALWAYS automatic!)
' also, boolean return code will FAIL if cfg is already active
tmpModel.ShowConfiguration2 (ConfigName) ' will return FALSE

' get the name of the active config
ActiveCfgName = tmpModel.GetActiveConfiguration.Name
' allow for capitalization errors
If UCase$(ConfigName) <> UCase$(ActiveCfgName) Then Exit Function

' Grab all the existing config Property names
PropNames = tmpModel.GetCustomInfoNames2(ConfigName)
NumProperties& = UBound(PropNames) ' if (-1) then NO props set

' Now Loop thru all the passed properties to view/change
For CProp& = 0 To UBound(PropName)
PName$ = PropName(CProp&) ' get string name of OUR property

' Now get the existing value of the existing custom property as STRING
retval$ = tmpModel.CustomInfo2(ConfigName, PName$)
' and get its real data type
swValType& = tmpModel.GetCustomInfoType3(ConfigName, PName$)

' and *IF* we are SETTING the value, get the type of data being SET
If Not IsEmpty(PropValue(CProp&)) Then
vbValType& = VarType(PropValue(CProp&))

' see if any data conversions are necessary
swDataIndex% = -1 ' get SW data Type Index: init to -1
For Sw% = 0 To UBound(swDataTypes)
If swDataTypes(Sw%) = swValType& Then swDataIndex% = Sw%: Exit For
Next Sw%

vbDataIndex% = -1 ' get VB data Type Index: init to -1
For VB% = 0 To UBound(vbDataTypes)
If vbDataTypes(VB%) = vbValType& Then vbDataIndex% = VB%: Exit For
Next VB%

If vbDataIndex% > -1 Then ' if not at least zero, you passed crap

' we will now set/create/write the passed data value
' We will also assume a data conversion is necessary here
' by forcing conversion to declared data type, variant will
' contain correct data type
If swDataIndex% = 0 Then ' nothing, make it what we want
If (vbDataIndex% = 0) Or (vbDataIndex% = 3) Then
strVal = CStr(PropValue(CProp&))
FieldType& = swDataTypes(3) ' string
FieldValue = strVal
ElseIf vbDataIndex% = 1 Then ' double
dblVal = CDbl(PropValue(CProp&))
FieldType& = swDataTypes(1)
FieldValue = dblVal
ElseIf vbDataIndex% = 2 Then ' boolean
boolVal = CBool(PropValue(CProp&))
FieldType& = swDataTypes(2)
FieldValue = boolVal
ElseIf vbDataIndex% = 4 Then ' date
strVal = CStr(PropValue(CProp&))
dateVal = CDate(strVal)
FieldType& = swDataTypes(4)
FieldValue = dateVal
End If


' Now we CREATE a new property here
retval = tmpModel.AddCustomInfo3(ConfigName, PName$, FieldType, FieldValue)
Else ' edit existing data

If swDataIndex% = 1 Then ' double prec
' convert to Single, then to double
sngVal = Val(PropValue(CProp&))
dblVal = CDbl(sngVal)
FieldValue = dblVal
ElseIf swDataIndex% = 2 Then ' Boolean
' convert to single, then boolean
sngVal = Val(PropValue(CProp&))
boolVal = CBool(sngVal)
FieldValue = boolVal
ElseIf swDataIndex% = 3 Then ' string
strVal = CStr(PropValue(CProp&))
FieldValue = strVal
ElseIf swDataIndex% = 4 Then ' date
' convert to string, then to date
strVal = CStr(PropValue(CProp&))
dateVal = CDate(strVal)
FieldValue = dateVal
End If

tmpModel.CustomInfo2(ConfigName, PName$) = FieldValue
End If

End If ' end of valid data passed logic


End If ' end of empty logic

' Now Read the data back in and store in an array
RetValues(CProp&) = tmpModel.CustomInfo2(ConfigName, PName$)
Next CProp&



' clean up temp Object variables before leaving Function
Set tmpModel = Nothing

' dump the array back into a variant and return
ComponentProps = RetValues()



End Function