使用SOLIDWORKS API按类型和/或名称模式在树中查找特征

特征管理器树 { width=250 }

此VBA宏允许使用SOLIDWORKS API在特征管理器树中查找特征。

可以通过指定类型名称和/或名称模式（支持通配符）来查找特征。将名称或类型名称设为空字符串以忽略此过滤器。

示例

Dim swFeat As SldWorks.Feature
Set swFeat = GetFirstFeature(swModel, "WeldMemberFeat") '返回第一个WeldMemberFeat类型（即结构成员）的特征

Dim swFeat As SldWorks.Feature
Set swFeat = GetFirstFeature(swModel, "", "Sk*") '返回名称以Sk开头的第一个特征

Dim vFeats As Variant
vFeats = GetAllFeatures(swModel, "WeldMemberFeat") '返回所有WeldMemberFeat类型（即结构成员）的特征

Dim vFeats As Variant
vFeats = GetAllFeatures(swModel, "", "Sk*")'返回名称以Sk开头的所有特征

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    Dim swFirstWeldFeat As SldWorks.Feature
    Set swFirstWeldFeat = GetFirstFeature(swModel, "WeldMemberFeat")
    
    Dim swFirstSkFeat As SldWorks.Feature
    Set swFirstSkFeat = GetFirstFeature(swModel, "", "Sk*")
    
    Dim swAllWeldFeats As Variant
    swAllWeldFeats = GetAllFeatures(swModel, "WeldMemberFeat")
    
    Dim swAllSkFeats As Variant
    swAllSkFeats = GetAllFeatures(swModel, "", "Sk*")
    
End Sub

Function GetFirstFeature(model As SldWorks.ModelDoc2, Optional typeName As String = "", Optional namePattern As String = "") As SldWorks.Feature
    
    Dim vFeats As Variant
    vFeats = GetFeatures(model, typeName, True, namePattern)
    
    If Not IsEmpty(vFeats) Then
        Set GetFirstFeature = vFeats(0)
    Else
        Set GetFirstFeature = Nothing
    End If
    
End Function

Function GetAllFeatures(model As SldWorks.ModelDoc2, Optional typeName As String = "", Optional namePattern As String = "") As Variant
    GetAllFeatures = GetFeatures(model, typeName, False, namePattern)
End Function

Function GetFeatures(model As SldWorks.ModelDoc2, typeName As String, firstOnly As Boolean, Optional namePattern As String = "") As Variant
    
    Dim swTargFeatsColl As Collection
    Set swTargFeatsColl = New Collection
    
    Dim swProcFeatsColl As Collection
    Set swProcFeatsColl = New Collection
    
    Dim swFeat As SldWorks.Feature
    Set swFeat = model.FirstFeature()
    
    While Not swFeat Is Nothing
                
        If Not Contains(swProcFeatsColl, swFeat) Then
            swProcFeatsColl.Add swFeat
            
            If FilterFeature(swFeat, typeName, namePattern) Then
                swTargFeatsColl.Add swFeat
                If firstOnly Then
                    GetFeatures = CollectionToArray(swTargFeatsColl)
                    Exit Function
                End If
            End If
        End If
    
        CollectAllSubFeatures swFeat, swProcFeatsColl, swTargFeatsColl, typeName, namePattern, firstOnly
        
        If firstOnly And swTargFeatsColl.Count() >= 1 Then
            GetFeatures = CollectionToArray(swTargFeatsColl)
            Exit Function
        End If
        
        Set swFeat = swFeat.GetNextFeature
        
    Wend
    
    GetFeatures = CollectionToArray(swTargFeatsColl)
    
End Function

Function FilterFeature(feat As SldWorks.Feature, typeName As String, namePattern As String) As Boolean
    
    If typeName <> "" Then
        If LCase(feat.GetTypeName2()) <> LCase(typeName) Then
            FilterFeature = False
            Exit Function
        End If
    End If
    
    If namePattern <> "" Then
        If Not feat.Name Like namePattern Then
            FilterFeature = False
            Exit Function
        End If
    End If
    
    FilterFeature = True
    
End Function

Sub CollectAllSubFeatures(swFeat As SldWorks.Feature, procFeatsColl As Collection, targFeatsColl As Collection, typeName As String, namePattern As String, firstOnly As Boolean)
    
    Dim swSubFeat As SldWorks.Feature
    Set swSubFeat = swFeat.GetFirstSubFeature
        
    While Not swSubFeat Is Nothing
        
        If Not Contains(procFeatsColl, swSubFeat) Then
            procFeatsColl.Add swSubFeat
            If FilterFeature(swSubFeat, typeName, namePattern) Then
                targFeatsColl.Add swSubFeat
                If firstOnly Then
                    Exit Sub
                End If
            End If
        End If
        
        CollectAllSubFeatures swSubFeat, procFeatsColl, targFeatsColl, typeName, namePattern, firstOnly
        Set swSubFeat = swSubFeat.GetNextSubFeature
        
    Wend
    
End Sub

Function CollectionToArray(coll As Collection) As Variant
    
    If coll.Count() > 0 Then
        
        Dim arr() As Object
        
        ReDim arr(coll.Count() - 1)
        Dim i As Integer
        
        For i = 1 To coll.Count
            Set arr(i - 1) = coll(i)
        Next
        
        CollectionToArray = arr
        
    Else
        CollectionToArray = Empty
    End If
    
End Function

Function Contains(coll As Collection, item As Object) As Boolean
    
    Dim i As Integer
    
    For i = 1 To coll.Count
        If coll.item(i) Is item Then
            Contains = True
            Exit Function
        End If
    Next
    
    Contains = False
    
End Function

示例​

示例