ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
LBLauritz Berg02/12/2020

I quickly threw together a macro to help fix some of our older parts manually:

It deletes all cfg specific properties and adds our standard properties to the configuration specific tab. Since this is my first macro I'd like someone with more experience to look over it & tell me if I need to adjust something in it or not - or if I can delete obsolete code.

I attached a test file too.


Here is the code:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2


Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

'delete all configuration specific properties in all configurations
    Dim vConf As Variant
    For Each vConf In swModel.GetConfigurationNames
        ClearCustPrps CStr(vConf)
    Next

'populate all configurations with their respective configuration specific properties
    For Each vConf In swModel.GetConfigurationNames
        PopulatePrps CStr(vConf)
    Next

MsgBox "Configuration specific properties deleted and repopulated!"

End Sub

'delete cfg specific properties
Sub ClearCustPrps(conf As String)
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim vPropNames As Variant
    Dim vPropName As Variant
    Set swCustPropMgr = swModel.Extension.CustomPropertyManager(conf)
    If Not swCustPropMgr Is Nothing Then
        swCustPropMgr.GetAll vPropNames, Empty, Empty
        If Not IsEmpty(vPropNames) Then
            For Each vPropName In vPropNames
                swCustPropMgr.Delete vPropName
                Debug.Print vPropName
            Next
        End If
    End If
End Sub


Sub PopulatePrps(ConfigName As String)

    Dim i As Long
    Dim PrtName As String
    Dim SetVal As Long
    Dim CusPropMgr As SldWorks.CustomPropertyManager
    Set CusPropMgr = swModel.Extension.CustomPropertyManager(ConfigName)
    'Values & custom property names
    Dim prpWeight As String
    Dim prpMatGrade As String
    Dim prpMatShape As String
    Dim prpMatSize As String
    Dim prpCutLength As String
    Dim prpCost As String

    Dim ValWeight As String
    Dim ValMatGrade As String
    Dim ValMatShape As String
    Dim ValMatSize As String
    Dim ValCutLength As String
    Dim ValCost As String

    Dim CusPrpArray(0 To 5, 0 To 1) As String

    'get part name
    PrtName = swModel.GetTitle

    'set standard values for properties
    prpWeight = "Weight"
    prpMatGrade = "Material Grade"
    prpMatShape = "Material Shape"
    prpMatSize = "Material Size"
    prpCutLength = "CutLength"
    prpCost = "Cost"

    ValWeight = """SW-Mass@@" & ConfigName & "@" & PrtName & """"
    ValMatGrade = """SW-Material@@" & ConfigName & "@" & PrtName & """"
    ValMatShape = "Plate"
    ValMatSize = """Thickness@@" & ConfigName & "@" & PrtName & """"
    ValCutLength = """Length@Sketch1@@" & ConfigName & "@" & PrtName & """"
    ValCost = """SW-Cost-TotalCost@@" & ConfigName & "@" & PrtName & """"

'fill array with standard values'
    CusPrpArray(0, 0) = prpWeight
    CusPrpArray(1, 0) = prpMatGrade
    CusPrpArray(2, 0) = prpMatShape
    CusPrpArray(3, 0) = prpMatSize
    CusPrpArray(4, 0) = prpCutLength
    CusPrpArray(5, 0) = prpCutLength
    CusPrpArray(0, 1) = ValWeight
    CusPrpArray(1, 1) = ValMatGrade
    CusPrpArray(2, 1) = ValMatShape
    CusPrpArray(3, 1) = ValMatSize
    CusPrpArray(4, 1) = ValCutLength
    CusPrpArray(5, 1) = ValCost

    'add values to custom properties
    For i = 0 To 5
        SetVal = CusPropMgr.Add3(CusPrpArray(i, 0), swCustomInfoType_e.swCustomInfoText, CusPrpArray(i, 1), swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
    Next i

End Sub

Next I want to add to copy everything from one of the configuration specific tabs (probably the active configuration) to the custom property tab. Any code I 'steal' from/modify easily to achieve this?

I found this already.

Thank you!