×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

VBA Custom Property Access ?

VBA Custom Property Access ?

VBA Custom Property Access ?

(OP)
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
www.deltagl.com

RE: VBA Custom Property Access ?

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.

RE: VBA Custom Property Access ?

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

RE: VBA Custom Property Access ?

'"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

RE: VBA Custom Property Access ?

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")
    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


RE: VBA Custom Property Access ?

' 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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources