Dim swApp As SldWorks.SldWorks
Dim AllFeatures As Variant
Dim allRelations As Variant
Dim allChild As Variant
Dim i As Long
Dim j As Long
Dim mySketch As Sketch
Dim RelMgr As SketchRelationManager
Dim ResultString As String
Dim ChildNames As String
Dim FixedCount As Long
Sub main()
Set swApp = Application.SldWorks
ResultString = ""
AllFeatures = Empty
AllFeatures = swApp.ActiveDoc.FeatureManager.GetFeatures(False)
For i = 0 To UBound(AllFeatures)
If AllFeatures(i).GetTypeName = "ProfileFeature" Then
Set mySketch = AllFeatures(i).GetSpecificFeature
If Not (mySketch Is Nothing) Then
Set RelMgr = mySketch.RelationManager
allRelations = Empty
allChild = Empty
allRelations = RelMgr.GetRelations(swAll)
allChild = mySketch.GetChildren
FixedCount = 0
For j = 0 To UBound(allRelations)
If allRelations(j).GetRelationType = swConstraintType_FIXED Then
FixedCount = FixedCount + 1
End If
Next j
ChildNames = " ("
For j = 0 To UBound(allChild)
ChildNames = ChildNames & allChild(j).Name & ", "
Next j
ChildNames = Left(ChildNames, Len(ChildNames) - 2) & ")"
If FixedCount > 0 Then
ResultString = ResultString & vbCrLf & FixedCount & " -" & mySketch.Name & ChildNames
End If
End If
End If
Next i
MsgBox "Quantity of ""Fixed"" relations" & vbCrLf & "per sketch in this model:" & vbCrLf & ResultString
End Sub