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 Mar 22, 2019 by Aleksandras Korolkovas

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)

             swModelDocExt.Create3DBoundingBox

 

            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

    Loop

     

    MsgBox "Done"

End Sub

Outcomes