Hide Table of Contents

Get Solid Bodies from Cut List Folders and Get Custom Properties Example (VBA)

This example shows how to get the solid bodies from cut list folders and how to get the custom properties for the solid bodies.

 

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim swPart As SldWorks.ModelDoc2

Dim swFeat As SldWorks.Feature

Dim Indent As Long

 

Sub GetFeatureCustomProps(thisFeat As SldWorks.Feature)

    Dim CustomPropMgr As SldWorks.CustomPropertyManager

    Set CustomPropMgr = thisFeat.CustomPropertyManager

    Dim vCustomPropNames As Variant

    vCustomPropNames = CustomPropMgr.GetNames

    If Not IsEmpty(vCustomPropNames) Then

        Dim NameFmt As String

        NameFmt = "!" & String(30, "@")

        Dim TypeFmt As String

        TypeFmt = "!" & String(6, "@")

        Dim ValFmt As String

        ValFmt = "!" & String(80, "@")

        Dim ResValFmt As String

        ResValFmt = "!" & String(40, "@")

        Debug.Print String(Indent + 3, " ") & "Cut List Custom Properties :"

        Dim i As Long

        For i = LBound(vCustomPropNames) To UBound(vCustomPropNames)

            Dim CustomPropName As String

            CustomPropName = vCustomPropNames(i)

            Debug.Print Format(String(Indent + 6, " ") & CustomPropName, NameFmt);

            Dim CustomPropType As Long

            CustomPropType = CustomPropMgr.GetType(CustomPropName)

            Dim CustomPropVal As String

            Dim CustomPropResolvedVal As String

            CustomPropMgr.Get2 CustomPropName, CustomPropVal, CustomPropResolvedVal

            Debug.Print Format(CustomPropVal, ValFmt);

            Debug.Print Format(CustomPropResolvedVal, ResValFmt)

        Next i

    End If

End Sub

Sub DoTheWork(thisFeat As SldWorks.Feature, ParentName As String)

    Static InBodyFolder As Boolean

    Static BodyFolderType(5) As String

    Static BeenHere As Boolean

    Dim bAllFeatures As Boolean

    Dim bCutListCustomProps As Boolean

    

    If Not BeenHere Then

        BodyFolderType(0) = "dummy"

        BodyFolderType(1) = "swSolidBodyFolder"

        BodyFolderType(2) = "swSurfaceBodyFolder"

        BodyFolderType(3) = "swBodySubFolder"

        BodyFolderType(4) = "swWeldmentSubFolder"

        BodyFolderType(5) = "swWeldmentCutListFolder"

        InBodyFolder = False

        BeenHere = True

        bAllFeatures = False

        bCutListCustomProps = False

    End If

    

    

    'Comment out next line to print information for just BodyFolders

    'bAllFeatures = True 'True to print information about all features

    'Comment out next line if do not want cut list's custom properties

    bCutListCustomProps = True  'True to print cut list's custom property information

    Dim FeatType As String

    FeatType = thisFeat.GetTypeName

    

    If (FeatType = "SolidBodyFolder") And (ParentName = "Root Feature") Then

        InBodyFolder = True

    End If

    

    If (FeatType <> "SolidBodyFolder") And (ParentName = "Root Feature") Then

        InBodyFolder = False

    End If

    If (InBodyFolder = False) And (FeatType = "CutListFolder") Then    'Only consider the CutListFolders that are under the SolidBodyFolder

        Exit Sub    'Skip the second occurrence of the CutListFolders during the feature traversal

    End If

    

    If (InBodyFolder = False) And (FeatType = "SubWeldFolder") Then    'Only consider the SubWeldFolder that are under the SolidBodyFolder

        Exit Sub    'Skip the second occurrence of the SubWeldFolders during the feature traversal

    End If

    

    Dim IsBodyFolder As Boolean

    If FeatType = "SolidBodyFolder" Or _

        FeatType = "SurfaceBodyFolder" Or _

        FeatType = "CutListFolder" Or _

        FeatType = "SubWeldFolder" Or _

        FeatType = "SubAtomFolder" _

        Then

        IsBodyFolder = True

    Else

        IsBodyFolder = False

    End If

    

    Dim FeatNameFmt As String

    FeatNameFmt = "!" & String(42, "@")

    

    If (FeatType = "FtrFolder") And (InStr(1, thisFeat.Name, "___EndTag___", 0) > 0) Then   'This is the folder End Tag

            Indent = Indent - 3

    End If

    If bAllFeatures And (Not IsBodyFolder) Then

        Debug.Print Format(String(Indent, " ") & thisFeat.Name, FeatNameFmt); Format(FeatType, "!" & String(18, "@"));

        Dim vSuppressed As Variant

        vSuppressed = thisFeat.IsSuppressed2(swThisConfiguration, Empty)

        If IsEmpty(vSuppressed) Then

            Debug.Print "IsSuppressed2 failed";

        Else

            Debug.Print Format(IIf(vSuppressed(0) = False, " ", "Suppressed"), "!" & String(15, "@"));

        End If

    End If

    If IsBodyFolder Then

        Dim BodyFolder As SldWorks.BodyFolder

        Set BodyFolder = thisFeat.GetSpecificFeature2

        Dim BodyCount As Long

        BodyCount = BodyFolder.GetBodyCount

        

        If (FeatType = "CutListFolder") And (BodyCount < 1) Then

            Exit Sub   'When BodyCount = 0, this cut list folder is not displayed in the

                       'Feature Manager design Tree, so skip it

        Else

            Debug.Print Format(String(Indent, " ") & thisFeat.Name, FeatNameFmt); Format(FeatType, "!" & String(18, "@"));

            vSuppressed = thisFeat.IsSuppressed2(swThisConfiguration, Empty)

            If IsEmpty(vSuppressed) Then

                Debug.Print "IsSuppressed2 failed";

            Else

                Debug.Print Format(IIf(vSuppressed(0) = False, " ", "Suppressed"), "!" & String(15, "@"));

            End If

        End If

        If Not bAllFeatures Then

            Debug.Print Format(String(Indent, " ") & thisFeat.Name, FeatNameFmt); Format(FeatType, "!" & String(18, "@"));

            vSuppressed = thisFeat.IsSuppressed2(swThisConfiguration, Empty)

            If IsEmpty(vSuppressed) Then

                Debug.Print "IsSuppressed2 failed";

            Else

                Debug.Print Format(IIf(vSuppressed(0) = False, " ", "Suppressed"), "!" & String(15, "@"));

            End If

        End If

        Dim BodyFolderTypeE As Long

        BodyFolderTypeE = BodyFolder.Type

        Debug.Print Format(BodyFolderType(BodyFolderTypeE), "!" & String(28, "@")); Format(BodyFolderTypeE, "!@@@@");

 

        Debug.Print Format("Body Count " & BodyCount, "!" & String(15, "@"))

        

        Dim vBodies As Variant

        vBodies = BodyFolder.GetBodies

        Dim i As Long

        If Not IsEmpty(vBodies) Then

            For i = LBound(vBodies) To UBound(vBodies)

                Dim Body As SldWorks.Body2

                Set Body = vBodies(i)

                Debug.Print Format(String(Indent + 3, " ") & Body.Name, "!" & String(32, "@"))

            Next i

        End If

    Else

        If bAllFeatures Then

            Debug.Print 'Finish off pending print line

        End If

    End If

    

    If (FeatType = "CutListFolder") Then

        If BodyCount > 0 Then   'When BodyCount = 0, this cut list folder is not displayed

                                'in the FeatureManager design tree, so skip it

            If bCutListCustomProps Then

                GetFeatureCustomProps thisFeat 'Comment out this line if you do not want to

                                               'print the cut list folder's custom properties

            End If

        End If

    End If

    

    If (FeatType = "FtrFolder") And (InStr(1, thisFeat.Name, "___EndTag___", 0) < 1) Then   'This is the folder start marker

            Indent = Indent + 3

    End If

End Sub

Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean, ParentName As String)

    Dim curFeat As SldWorks.Feature

    Set curFeat = thisFeat

    Indent = Indent + 3

    

    While Not curFeat Is Nothing

        DoTheWork curFeat, ParentName 'Do the thing that we are doing this feature traversal for

        

        Dim subfeat As SldWorks.Feature

        Set subfeat = curFeat.GetFirstSubFeature

        While Not subfeat Is Nothing

            TraverseFeatures subfeat, False, curFeat.Name

            Dim nextSubFeat As SldWorks.Feature

            Set nextSubFeat = subfeat.GetNextSubFeature

            Set subfeat = nextSubFeat

            Set nextSubFeat = Nothing

        Wend

        Set subfeat = Nothing

        

        Dim nextFeat As SldWorks.Feature

        If isTopLevel Then

            Set nextFeat = curFeat.GetNextFeature

        Else

            Set nextFeat = Nothing

        End If

        Set curFeat = nextFeat

        Set nextFeat = Nothing

    Wend

    Indent = Indent - 3

End Sub

Sub main()

    Set swApp = Application.SldWorks

    Set swPart = swApp.ActiveDoc

    Debug.Print "File = " & swPart.GetPathName

    

    Dim ConfigName As String

    ConfigName = swPart.ConfigurationManager.ActiveConfiguration.Name

    Debug.Print "Active Configuration Name = " & ConfigName

    

    Indent = -3

    Set swFeat = swPart.FirstFeature

    TraverseFeatures swFeat, True, "Root Feature"

End Sub



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Get Solid Bodies from Cut-list Folders and Get Custom Properties Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2010 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.