AnsweredAssumed Answered

Get body from Cut List

Question asked by Samantha Szkirpan on Jun 9, 2017
Latest reply on Jun 9, 2017 by Samantha Szkirpan


I am using VBA to program this macro.

I am trying to navigate the feature tree of a part that has a cut list folder. This folder contains a subweldments folder which contains more cut list folders which each contain what I believe are solid bodies. What I want to do is access the solid bodies in these cut list folders and save them as a parasolid. However I am running into an issue accessing the bodies and I'm not sure what I am doing wrong.


Here is my code, and I would appreciate any help.


Sub weldments()

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swSelMgr As SldWorks.SelectionMgr

    Dim swselObject As Object

    Dim swEnt As SldWorks.Entity

    Dim swComp As SldWorks.Component2

    Dim modelName As String

    Dim material As String

    Dim featName As String

    Dim subName As String

    Dim sub2Name As String

    Dim sub3name As String

    Dim bodyCount As Integer

    Dim swFeat As SldWorks.Feature

    Dim subFeat As SldWorks.Feature

    Dim sub2Feat As SldWorks.Feature

    Dim sub3Feat As Object

    Dim swCustPropMgr As SldWorks.CustomPropertyManager

    Dim dash As String



    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    modelName = swModel.GetTitle

    boolstatus = swModel.Extension.SelectByID2("Description", "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)

    Set swSelMgr = swModel.SelectionManager

    Set swFeat = swSelMgr.GetSelectedObject(1)

    featName = swFeat.Name


    Set subFeat = swFeat.GetFirstSubFeature

    subName = subFeat.Name

    If subFeat.Name = "Sub-weldment1" Then

        Set sub2Feat = subFeat.GetFirstSubFeature

        sub2Name = sub2Feat.GetTypeName

        Do While Not subFeat Is Nothing

        If sub2Feat.Name = "Cut-List-Item2" Then

            Set swCustPropMgr = sub2Feat.CustomPropertyManager

            swCustPropMgr.Get4 "DASH", False, Empty, dash

            swCustPropMgr.Get4 "MATERIAL", False, Empty, material

            Dim folder As SldWorks.bodyFolder

            Set folder = sub2Feat.GetSpecificFeature2

           sub3Feat = sub2Feat.GetBodies