AnsweredAssumed Answered

Macro to add a cut list propertie just to sheet metal items?

Question asked by Guilheme Azevedo on Mar 17, 2019
Latest reply on Apr 14, 2020 by Arif Akbas

HI everyone! How are  you doing?! I´m having troubles to add a cut list propertie to each sheet metal part inside my multibody project. For example: I want to add a property "Description" with has the value "  anything". I took a macro in this forum that does it, but it add the propertie to the weldments too, like tubes or extrusion bodyes.


Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swFeat As SldWorks.Feature

Dim swDeleteFaceFeature As SldWorks.DeleteFaceFeatureData

Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim names As Variant

Dim textexp As String

Dim evalval As String


Dim featureName As String

Dim boolstatus As Boolean

Dim opt As Long


Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swModelDocExt = swModel.Extension


    ' Get the DeleteFace feature

    Set swFeat = swModel.FirstFeature


     Do While Not swFeat Is Nothing


        If swFeat Is Nothing Then

            Exit Do

        End If


        featureName = swFeat.Name


There is a way to say the SoliWorks: " Hey buddy, from here to bottom let just sheet metals pass thrugh! ".  


        If swFeat.GetTypeName2 = "CutListFolder" Then

             boolstatus = swModelDocExt.SelectByID2(featureName, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)



            Set swCustPropMgr = swFeat.CustomPropertyManager

            swCustPropMgr.Add3 "Description", swCustomInfoType_e.swCustomInfoText, " Chapa # " & """SW-Espessura da Chapa metálica@@@" & swFeat.Name & "@" & FileName & ".SLDPRT""" & " x """ & "SW-Comprimento da Caixa delimitadora@@@" & swFeat.Name & "@" & FileName & ".SLDPRT""" & " x """ & "SW-Largura da Caixa delimitadora@@@" & swFeat.Name & "@" & FileName & ".SLDPRT""", swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd


        End If


        Debug.Print swFeat.GetTypeName2

        Set swFeat = swFeat.GetNextFeature



    MsgBox "Done"

End Sub