Find features in the tree by type and/or name pattern using SOLIDWORKS API
This VBA macro allows to find features in the Feature Manager tree using SOLIDWORKS API.
Features can be found by specifying the type name and/or name pattern (with support of wildcards). Specify empty string for name or type name to ignore this filter.
Examples
Dim swFeat As SldWorks.Feature Set swFeat = GetFirstFeature(swModel, "WeldMemberFeat") 'return first feature of WeldMemberFeat type (i.e. Structural Member)
Dim swFeat As SldWorks.Feature Set swFeat = GetFirstFeature(swModel, "", "Sk*") 'return first feature which name starts with Sk
Dim vFeats As Variant vFeats = GetAllFeatures(swModel, "WeldMemberFeat") 'return all features of WeldMemberFeat type (i.e. Structural Members)
Dim vFeats As Variant vFeats = GetAllFeatures(swModel, "", "Sk*")'return all features whose names starts with 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