Folge 20 – Feature Manager durchsuchen I

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Keine Datei geöffnet.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        Exit Sub
    End If
    
    Dim swFeatMgr As FeatureManager
    Set swFeatMgr = swModel.FeatureManager
    
    Dim featArray As Variant
    featArray = swFeatMgr.GetFeatures(True)
    Debug.Print "------------------------------------------------------"
    Dim vFeature As Variant
    Dim swFeature As Feature
    For Each vFeature In featArray
        Set swFeature = vFeature
        'Debug.Print swFeature.Name
    Next
    
    Dim counter As Long
    For counter = 0 To UBound(featArray)
        Set swFeature = featArray(counter)
        'Debug.Print swFeature.Name
        'Debug.Print swFeature.GetTypeName2
        If swFeature.GetTypeName2 = "ProfileFeature" Then
            Debug.Print swFeature.Name
        End If
    Next counter
End Sub