Public Sub VirtualComponentCount()
' Set reference to active document.
' This assumes the active document is an assembly
Dim oDoc As Inventor.AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
' Get assembly component definition
Dim oCompDef As Inventor.ComponentDefinition
Set oCompDef = oDoc.ComponentDefinition
Dim sMsg As String
Dim iLeafNodes As Long
Dim iSubAssemblies As Long
Debug.Print "--------------------------------"
Debug.Print " Top Level Assembly: " & oDoc.DisplayName
Debug.Print "--------------------------------"
' Get all occurrences from component definition for Assembly document
Dim oCompOcc As ComponentOccurrence
For Each oCompOcc In oCompDef.Occurrences
' Check if it's child occurrence (leaf node)
If (Not oCompOcc.IsSubstituteOccurrence) And _
(Not oCompOcc.Suppressed) Then
If oCompOcc.SubOccurrences.Count = 0 Then
If TypeOf oCompOcc.Definition Is VirtualComponentDefinition Then
Debug.Print oCompOcc.Name
iLeafNodes = iLeafNodes + 1
End If
Else
Debug.Print "----------"
Debug.Print " SubAssembly: " & oCompOcc.Name
Debug.Print "----------"
iSubAssemblies = iSubAssemblies + 1
Call processAllSubOcc(oCompOcc, _
sMsg, _
iLeafNodes, _
iSubAssemblies) ' subassembly
End If
End If
Next
Debug.Print "--------"
Debug.Print "No of virtual components: " + CStr(iLeafNodes)
Debug.Print "No of sub assemblies: " + CStr(iSubAssemblies)
End Sub
' This function is called for processing sub assembly. It is called recursively
' to iterate through the entire assembly tree.
Private Sub processAllSubOcc(ByVal oCompOcc As ComponentOccurrence, _
ByRef sMsg As String, _
ByRef iLeafNodes As Long, _
ByRef iSubAssemblies As Long)
Dim oSubCompOcc As ComponentOccurrence
For Each oSubCompOcc In oCompOcc.SubOccurrences
' Check if it's child occurrence (leaf node)
If (Not oSubCompOcc.IsSubstituteOccurrence) And _
(Not oSubCompOcc.Suppressed) Then
If oSubCompOcc.SubOccurrences.Count = 0 Then
If TypeOf oSubCompOcc.Definition Is VirtualComponentDefinition Then
Debug.Print oSubCompOcc.Name
iLeafNodes = iLeafNodes + 1
End If
Else
sMsg = sMsg + oSubCompOcc.Name + vbCr
iSubAssemblies = iSubAssemblies + 1
Call processAllSubOcc(oSubCompOcc, _
sMsg, _
iLeafNodes, _
iSubAssemblies)
End If
End If
Next
Beep
End Sub
