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.

'---------------------------------------------------------------
' Preconditions:
' 1. Verify that c:\temp\outputFile.txt does not exist; this macro
'    creates and writes to this file.
' 2. Add a reference to Microsoft Scripting Runtime (click
'    Tools > References > Browse > C:\windows\system32\scrrun.dll).
' 3. Open install_dir\samples\tutorial\api\weldment_box3.sldprt.
' 4. Click Tools > Options > Document Properties > Weldments >
'    Rename cut list folders with Description property value.
' 5. Right-click Cut list(31) in the FeatureManager design tree
'    and click Update.
' 6. Open the Immediate window.
'
' Postconditions:
' 1. Traverses the FeatureManager design tree.
' 2. Writes Done! to the Immediate window when
'    the macro finishes executing.
' 3. Open and examine c:\temp\outputFile.txt.
'
' NOTE: Because this part is used elsewhere, do not save changes.
'----------------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim fs As Scripting.FileSystemObject
Dim a As Scripting.TextStream
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
        a.WriteLine "               Cut-list custom properties:"
        Dim i As Long
        For i = LBound(vCustomPropNames) To UBound(vCustomPropNames)
            Dim CustomPropName As String
            CustomPropName = vCustomPropNames(i)
            Dim CustomPropType As Long
            CustomPropType = CustomPropMgr.GetType2(CustomPropName)
            Dim CustomPropVal As String
            Dim CustomPropResolvedVal As String
            CustomPropMgr.Get2 CustomPropName, CustomPropVal, CustomPropResolvedVal
            a.WriteLine "                     Name: " & CustomPropName
            a.WriteLine "                         Value: " & CustomPropVal
            a.WriteLine "                         Resolved value: " & CustomPropResolvedVal
        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
    Dim vSuppressed As Variant
    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 you do not want cut list's custom properties
    bCutListCustomProps = True
    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    
    'Only consider the CutListFolders that are under SolidBodyFolder
    If (InBodyFolder = False) And (FeatType = "CutListFolder") Then
        'Skip the second occurrence of the CutListFolders during the feature traversal
        Exit Sub
    End If
    
    'Only consider the SubWeldFolder that are under the SolidBodyFolder
    If (InBodyFolder = False) And (FeatType = "SubWeldFolder") Then
        'Skip the second occurrence of the SubWeldFolders during the feature traversal
        Exit Sub
    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
    If bAllFeatures And (Not IsBodyFolder) Then
        a.WriteLine "Feature name: " & thisFeat.Name
        a.WriteLine "   Feature type: " & FeatType
        vSuppressed = thisFeat.IsSuppressed2(swInConfigurationOpts_e.swThisConfiguration, Nothing)
        If IsEmpty(vSuppressed) Then
            a.WriteLine "        Suppression failed"
        Else
            a.WriteLine "        Suppressed"
        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
            'When BodyCount = 0, this cut list folder is not displayed in the
            'FeatureManager design tree, so skip it
            Exit Sub
        Else
            a.WriteLine "Feature name: " & thisFeat.Name
            vSuppressed = thisFeat.IsSuppressed2(swInConfigurationOpts_e.swThisConfiguration, Empty)
            If IsEmpty(vSuppressed) Then
                a.WriteLine "       Suppression failed"
            Else
                a.WriteLine "       Suppressed"
            End If
        End If
        If Not bAllFeatures Then
            a.WriteLine "Feature name: " & thisFeat.Name
            vSuppressed = thisFeat.IsSuppressed2(swInConfigurationOpts_e.swThisConfiguration, Empty)
            If IsEmpty(vSuppressed) Then
                a.WriteLine "       Suppression failed"
            Else
                a.WriteLine "       Suppressed"
            End If
        End If
        Dim BodyFolderTypeE As Long
        BodyFolderTypeE = BodyFolder.Type
        a.WriteLine "        Body folder: " & BodyFolderType(BodyFolderTypeE)
        a.WriteLine "        Body folder type: BodyFolderTypeE"
        a.WriteLine "        Body count: " & BodyCount
        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)
                a.WriteLine "           Body name: " & Body.Name
            Next i
        End If
    Else
        If bAllFeatures Then
            a.WriteLine ""
        End If
    End If
    If (FeatType = "CutListFolder") Then
        'When BodyCount = 0, this cut list folder is not displayed
        'in the FeatureManager design tree, so skip it
        If BodyCount > 0 Then
            If bCutListCustomProps Then
                'Comment out this line if you do not want to
                'print the cut list folder's custom properties
                GetFeatureCustomProps thisFeat
            End If
        End If
    End If
End Sub
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean, ParentName As String)
    Dim curFeat As SldWorks.Feature
    Set curFeat = thisFeat
    While Not curFeat Is Nothing
        DoTheWork curFeat, ParentName
        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
End Sub
Sub main()
    Set swApp = Application.SldWorks
    Set swPart = swApp.ActiveDoc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("c:\temp\outputFile.txt", True)
    a.WriteLine "File: " & swPart.GetPathName
    Dim ConfigName As String
    ConfigName = swPart.ConfigurationManager.ActiveConfiguration.Name
    a.WriteLine "Active configuration name: " & ConfigName
    Set swFeat = swPart.FirstFeature
    TraverseFeatures swFeat, True, "Root Feature"
    a.Close
    Debug.Print "Done!"
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) 2015 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.