Rename flat pattern views with cut-list names VBA macro

Edit ArticleEdit Article
More 'Goodies'

Cut-list for sheet metal body
Cut-list for sheet metal body

Cut list names for sheet metal bodies can be used to store important information, such as part number. This VBA macro allows to rename all flat pattern views of sheet metal in the active drawing sheet with the name of the respective cut-list item using SOLIDWORKS API.

Drawing view renamed after the cut-list
Drawing view renamed after the cut-list

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    Dim swDraw As SldWorks.DrawingDoc
    On Error GoTo catch
    Set swDraw = swApp.ActiveDoc
    If Not swDraw Is Nothing Then
        RenameFlatPatternViews swDraw, swDraw.GetCurrentSheet
        Err.Raise vbError, "", "Please open drawing document"
    End If
    GoTo finally
    MsgBox Err.Description & " (" & Err.Number & ")", vbCritical
End Sub

Sub RenameFlatPatternViews(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)
    Dim vViews As Variant
    vViews = GetSheetViews(draw, sheet)
    If Not IsEmpty(vViews) Then
        Dim i As Integer
        For i = 0 To UBound(vViews)
            Dim swView As SldWorks.view
            Set swView = vViews(i)
            If swView.IsFlatPatternView() Then
                Debug.Print "Renaming " & swView.Name
                Dim swBody As SldWorks.Body2
                Set swBody = GetFlatPatternViewBody(swView)
                Dim swCutListFeat As SldWorks.Feature
                Dim activeConf As String
                activeConf = swView.ReferencedDocument.ConfigurationManager.ActiveConfiguration.Name
                swView.ReferencedDocument.ShowConfiguration2 swView.ReferencedConfiguration
                Set swCutListFeat = GetCutListFromBody(swView.ReferencedDocument, swBody)
                swView.ReferencedDocument.ShowConfiguration2 activeConf
                If swCutListFeat Is Nothing Then
                    Err.Raise vbError, "", "Failed to find cut list for " & swView.Name
                End If
                swView.SetName2 swCutListFeat.Name
            End If
    End If
End Sub

Function GetFlatPatternViewBody(view As SldWorks.view) As SldWorks.Body2
    Dim vVisComps As Variant
    vVisComps = view.GetVisibleComponents()
    If IsEmpty(vVisComps) Then
        Err.Raise vbError, "", view.Name & " doesn't have visible components"
    End If
    Dim swComp As SldWorks.Component2
    Set swComp = vVisComps(0)
    Dim vFaces As Variant
    vFaces = view.GetVisibleEntities(swComp, swViewEntityType_e.swViewEntityType_Face)
    If IsEmpty(vFaces) Then
        Err.Raise vbError, "", view.Name & " doesn't have visible faces"
    End If
    Dim swFace As SldWorks.Face2
    Set swFace = vFaces(i)
    Dim swBody As SldWorks.Body2
    Set swBody = swFace.GetBody
    Set GetFlatPatternViewBody = swBody
End Function

Function GetCutListFromBody(model As SldWorks.ModelDoc2, body As SldWorks.Body2) As SldWorks.Feature
    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
            Set swBodyFolder = swFeat.GetSpecificFeature2
            Dim vBodies As Variant
            vBodies = swBodyFolder.GetBodies
            Dim i As Integer
            If Not IsEmpty(vBodies) Then
                For i = 0 To UBound(vBodies)
                    Dim swCutListBody As SldWorks.Body2
                    Set swCutListBody = vBodies(i)
                    If UCase(swCutListBody.Name) = UCase(body.Name) Then
                        Set GetCutListFromBody = swFeat
                        Exit Function
                    End If
            End If
        End If
        Set swFeat = swFeat.GetNextFeature

End Function

Function GetSheetViews(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet) As Variant

    Dim vSheets As Variant
    vSheets = draw.GetViews()
    Dim i As Integer
    For i = 0 To UBound(vSheets)
        Dim vViews As Variant
        vViews = vSheets(i)
        Dim swSheetView As SldWorks.view
        Set swSheetView = vViews(0)
        If UCase(swSheetView.Name) = UCase(sheet.GetName()) Then
            If UBound(vViews) > 0 Then
                Dim swViews() As SldWorks.view
                ReDim swViews(UBound(vViews) - 1)
                Dim j As Integer
                For j = 1 To UBound(vViews)
                    Set swViews(j - 1) = vViews(j)
                GetSheetViews = swViews
                Exit Function
            End If
        End If
End Function


All articles and code at CodeStack are now open-source and hosted on GitHub. If you want to contribute by modifying existing articles and code snippets, submitting new ones, reporting errors and bugs etc. please follow this blog post for more information. We appreciate any contribution.

Product of Xarial Product of Xarial