More 'Goodies'

Sheet metal cut list features
Sheet metal cut list features

This VBA macro allows to rename all cut list features for weldment and sheet metal part based on the name template which can include values of custom properties and free text.

Cut list properties
Cut list properties

To configure the macro modify the values of NAME_TEMPLATE and PROPERTIES variables

  • NAME_TEMPLATE can contain free text and 0-based placeholders which will be dynamically replaced by corresponding custom properties values
  • Set the names of the properties to extract by assigning the Array of PROPERTIES variable in Init function
Const NAME_TEMPLATE = "FreeText_{0}_{1}_{2}_{3}" 'Each feature is renamed with FreeText_ followed by the value of the first custom property specified in PROPERTIES, then _ etc.
Dim PROPERTIES As Variant

Dim swApp As SldWorks.SldWorks

Sub Init(Optional dummy As Variant = Empty)
    PROPERTIES = Array("Prp1", "Prp2", "Prp3", "Prp4") 'custom properties to extract. Value of Prp1 will replace {0}, Prp2 will replace {1} etc.
End Sub
Const NAME_TEMPLATE = "SM_{0}x{1}x{2}"
Dim PROPERTIES As Variant

Dim swApp As SldWorks.SldWorks

Sub Init(Optional dummy As Variant = Empty)
    PROPERTIES = Array("Bounding Box Length", "Bounding Box Width", "Sheet Metal Thickness")
End Sub

Sub main()

    Init
    
    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        
        Dim vCutLists As Variant
        vCutLists = GetCutLists(swModel)
        
        Dim i As Integer
        
        For i = 0 To UBound(vCutLists)
            Dim swCutListFeat As SldWorks.Feature
            Set swCutListFeat = vCutLists(i)
            Dim vPrpVals As Variant
            vPrpVals = ReadProperties(swCutListFeat.CustomPropertyManager, PROPERTIES)
            swCutListFeat.Name = FormatString(NAME_TEMPLATE, vPrpVals)
        Next
        
    Else
        MsgBox "Please open the document"
    End If
    
End Sub

Function ReadProperties(custPrpMgr As SldWorks.CustomPropertyManager, prpNames As Variant) As Variant
    
    Dim prpValues() As String
    
    ReDim prpValues(UBound(prpNames))
    
    Dim i As Integer
    
    For i = 0 To UBound(prpNames)
        Dim resVal As String
        custPrpMgr.Get2 CStr(prpNames(i)), "", resVal
        prpValues(i) = resVal
    Next
    
    ReadProperties = prpValues
    
End Function

Function GetCutLists(model As SldWorks.ModelDoc2) As Variant
    
    Dim swCutListFeats() As SldWorks.Feature
    Dim isInit As Boolean
    isInit = False
    
    Dim swFeat As SldWorks.Feature
    Dim swBodyFolder As SldWorks.BodyFolder
    
    Set swFeat = model.FirstFeature
    
    Do While Not swFeat Is Nothing
        
        If swFeat.GetTypeName2 = "CutListFolder" Then
            
            If Not isInit Then
                isInit = True
                ReDim swCutListFeats(0)
            Else
                ReDim Preserve swCutListFeats(UBound(swCutListFeats) + 1)
            End If
            
            Set swCutListFeats(UBound(swCutListFeats)) = swFeat
            
        End If
        
        Set swFeat = swFeat.GetNextFeature
        
    Loop
    
    GetCutLists = swCutListFeats

End Function

Function FormatString(inputStr As String, params As Variant)
    
    Dim resStr As String
    resStr = inputStr
    
    Dim i As Integer
    
    For i = 0 To UBound(params)
        resStr = Replace(resStr, "{" & i & "}", CStr(params(i)))
    Next
    
    FormatString = resStr
    
End Function