Counting parts (or sub assemblies) & Virtual Parts in an Assembly.

[Kersh]

Wrote some code (Thanks Ai) for counting parts in an assembly. You can pre-select a part or run it with nothing selected.
have a play. I use 'Button Constructor' to add a  QTY - Count Parts button to my Measure tab in Inventor.
Save the below into a text file (Count Parts.txt) in your 'External Rules' location.
File and Icon added below. 😁

' Count Parts (Real & Virtual) — External iLogic Rule (Auto mode)
' - REAL labels: [REAL] <UPPERCASE PN> (fallback: [REAL] (NO PN) <UPPERCASE-FILENAME>)
' - VIRTUAL labels: [VIRTUAL] <PN> (no description, no "PN:")
' - Virtual COUNT prompt: Top level only (Structured) vs All levels (Parts Only)
' - Search still finds virtual PNs from all levels
' - Natural numeric sort (inline)
' - Highlight warning only for real/asm when count > 300
' - Custom wide picker (no System.Drawing)
' - Single Sub Main

Sub Main()

' --- Settings ---
Const HIGHLIGHT_WARN_THRESHOLD As Integer = 300
Const HIGHLIGHT_WARN_TEXT As String = "WARNING - This may take a while."
Const PICKER_WIDTH As Integer = 350
Const PICKER_HEIGHT As Integer = 500
Const PICKER_PROMPT As String = "Select a component to count:"

' -- Ensure active document is an assembly
Dim oAsm As AssemblyDocument = Nothing
Try
oAsm = ThisApplication.ActiveDocument
If oAsm Is Nothing OrElse oAsm.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
MessageBox.Show("Please open an assembly document.", "Invalid Document")
Exit Sub
End If
Catch
MessageBox.Show("No active document found.", "Error")
Exit Sub
End Try

' -- Prepare BOM views
Dim oBOM As BOM = oAsm.ComponentDefinition.BOM
If Not oBOM.StructuredViewEnabled Then oBOM.StructuredViewEnabled = True
If Not oBOM.PartsOnlyViewEnabled Then oBOM.PartsOnlyViewEnabled = True

Dim oStructuredRows As BOMRowsEnumerator = oBOM.BOMViews.Item("Structured").BOMRows
Dim oPartsOnlyRows As BOMRowsEnumerator = oBOM.BOMViews.Item("Parts Only").BOMRows ' all levels

Dim oSelectSet As SelectSet = oAsm.SelectSet

' ============================
' CASE A: Something selected
' ============================
If oSelectSet.Count > 0 Then

' First ComponentOccurrence in selection
Dim selOcc As ComponentOccurrence = Nothing
For Each it As Object In oSelectSet
If TypeOf it Is ComponentOccurrence Then
selOcc = CType(it, ComponentOccurrence)
Exit For
End If
Next

If selOcc Is Nothing Then
MessageBox.Show("Selected item is not a component occurrence.", "Invalid Selection")
Exit Sub
End If

Dim isVirtual As Boolean = False
Try
isVirtual = TypeOf selOcc.Definition Is VirtualComponentDefinition
Catch
isVirtual = False
End Try

If isVirtual Then
' ---- VIRTUAL: ask scope, then count via chosen BOM view ----
Dim pn As String = ""
Try
pn = CStr(selOcc.Definition.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)
Catch
pn = ""
End Try
Dim pnL As String = LCase(Trim(pn))
If pnL = "" Then
MessageBox.Show("Could not read Part Number for the selected virtual component.", "Read Error")
Exit Sub
End If

Dim scopeAllLevels As Boolean = (MsgBox("Search all levels (Parts Only)?", _
MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Virtual Count Scope") = MsgBoxResult.Yes)

Dim rows As BOMRowsEnumerator = Nothing
If scopeAllLevels Then
rows = oPartsOnlyRows
Else
rows = oStructuredRows
End If

Dim totalQty As Double = 0.0
For Each oRow As BOMRow In rows
Try
Dim compDef As ComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim rowPN As String = LCase(Trim(CStr(compDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)))
If rowPN = pnL Then
totalQty += oRow.TotalQuantity ' respects overrides; Parts Only rolls up
End If
Catch
' ignore row
End Try
Next

Dim scopeNote As String = IIf(scopeAllLevels, _
"(Using manually overridden BOM quantity; includes all levels)", _
"(Using manually overridden BOM quantity; top level only)")

Dim msgV As String = vbCrLf & vbCrLf & _
"==============================" & vbCrLf & _
" QTY FOUND: " & totalQty & vbCrLf & _
"==============================" & vbCrLf & vbCrLf & _
scopeNote & vbCrLf
MsgBox(msgV, MsgBoxStyle.Information, "Count Result (Virtual)")
Exit Sub

Else
' ---- REAL / SUB-ASM: count occurrences + (optional) highlight ----
Dim targetDoc As Document = Nothing
Try
targetDoc = selOcc.Definition.Document
Catch
MessageBox.Show("Could not resolve document of the selected component.", "Read Error")
Exit Sub
End Try

Dim foundOccs As New System.Collections.Generic.List(Of ComponentOccurrence)
Dim cnt As Integer = 0
For Each occ As ComponentOccurrence In oAsm.ComponentDefinition.Occurrences.AllReferencedOccurrences(targetDoc)
Try
If occ.Definition.Document.FullFileName = targetDoc.FullFileName Then
cnt += 1
foundOccs.Add(occ)
End If
Catch
' ignore
End Try
Next

Dim footer As String = ""
If cnt > HIGHLIGHT_WARN_THRESHOLD Then footer = HIGHLIGHT_WARN_TEXT

Dim msgR As String = vbCrLf & vbCrLf & _
"==============================" & vbCrLf & _
" QTY FOUND: " & cnt & vbCrLf & _
"==============================" & vbCrLf & vbCrLf
If footer <> "" Then msgR &= footer & vbCrLf
msgR &= "Would you like to highlight them?"

Dim response As MsgBoxResult = MsgBox(msgR, MsgBoxStyle.YesNo + MsgBoxStyle.Information, "Count Result (Real/Assembly)")
If response = MsgBoxResult.Yes Then
Try
oAsm.SelectSet.Clear()
For Each occ As ComponentOccurrence In foundOccs
oAsm.SelectSet.Select(occ)
Next
ThisApplication.ActiveView.Fit()
Catch
' some may be suppressed/rolled up
End Try
End If
Exit Sub
End If

End If ' selection path

' ============================
' CASE B: Nothing selected → Auto search (REAL + VIRTUAL)
' ============================

Dim searchTerm As String = InputBox("Enter part of the name or number to search for:", "Search")
If String.IsNullOrEmpty(searchTerm) Then Exit Sub
Dim q As String = LCase(Trim(searchTerm))

' Build hit maps:
' realHits: label -> Document
' virtualHits: label -> lower(PN)
Dim realHits As New System.Collections.Generic.Dictionary(Of String, Document)
Dim virtualHits As New System.Collections.Generic.Dictionary(Of String, String)

' --- REAL hits (match by file name OR PN) ---
For Each oDoc As Document In oAsm.AllReferencedDocuments
Try
Dim nameOnly As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
Dim nameOnlyL As String = LCase(Trim(nameOnly))
Dim pnDocRaw As String = ""
Try
pnDocRaw = CStr(oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)
Catch
pnDocRaw = ""
End Try
Dim pnDocL As String = LCase(Trim(pnDocRaw))
Dim pnDocU As String = UCase(Trim(pnDocRaw)) ' label uses UPPERCASE PN

If nameOnlyL.Contains(q) OrElse pnDocL.Contains(q) Then
Dim labelR As String
If pnDocU <> "" Then
labelR = "[REAL] " & pnDocU ' PN only, uppercased
Else
labelR = "[REAL] (NO PN) " & UCase(nameOnly) ' fallback
End If
If Not realHits.ContainsKey(labelR) Then
realHits.Add(labelR, oDoc)
End If
End If
Catch
' ignore doc
End Try
Next

' --- VIRTUAL hits from BOM (by PN) — search Parts Only to see lower levels ---
For Each oRow As BOMRow In oPartsOnlyRows
Try
Dim compDef As ComponentDefinition = oRow.ComponentDefinitions.Item(1)
If TypeOf compDef Is VirtualComponentDefinition Then
Dim pnV As String = ""
Try
pnV = CStr(compDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)
Catch
pnV = ""
End Try
Dim pnVL As String = LCase(Trim(pnV))
If pnVL.Contains(q) Then
Dim labelV As String = "[VIRTUAL] " & pnV ' no description, no "PN:"
If Not virtualHits.ContainsKey(labelV) Then
virtualHits.Add(labelV, pnVL)
End If
End If
End If
Catch
' ignore row
End Try
Next

' Combine labels
Dim labels As New System.Collections.Generic.List(Of String)
For Each k As String In realHits.Keys
labels.Add(k)
Next
For Each k As String In virtualHits.Keys
labels.Add(k)
Next

If labels.Count = 0 Then
MessageBox.Show("No matching components found.", "Search Result")
Exit Sub
End If

' --- Natural numeric sort (inline) on the PN portion of the label ---
Dim keys As New System.Collections.Generic.List(Of String)
Dim idx As Integer
For Each lbl As String In labels
Dim pnText As String = lbl
idx = lbl.IndexOf("] ")
If idx >= 0 AndAlso idx + 2 < lbl.Length Then
pnText = lbl.Substring(idx + 2).Trim()
End If

Dim sb As New System.Text.StringBuilder()
Dim i As Integer = 0
While i < pnText.Length
Dim ch As Char = pnText.Chars(i)
If Char.IsDigit(ch) Then
Dim j As Integer = i
While j < pnText.Length AndAlso Char.IsDigit(pnText.Chars(j))
j += 1
End While
Dim run As String = pnText.Substring(i, j - i)
Dim padded As String = run.PadLeft(10, "0"c) ' pad numbers to 10 digits
sb.Append(padded)
i = j
Else
sb.Append(Char.ToUpperInvariant(ch)) ' case-insensitive
i += 1
End If
End While
keys.Add(sb.ToString())
Next

' In-place insertion sort using the computed keys
Dim a As Integer
For a = 1 To labels.Count - 1
Dim keyKey As String = keys(a)
Dim keyLbl As String = labels(a)
Dim m As Integer = a - 1
While m >= 0 AndAlso String.Compare(keys(m), keyKey, StringComparison.Ordinal) > 0
keys(m + 1) = keys(m)
labels(m + 1) = labels(m)
m -= 1
End While
keys(m + 1) = keyKey
labels(m + 1) = keyLbl
Next

' ===== Custom WIDE picker (no System.Drawing) =====
Dim picked As String = ""

Dim dlg As New System.Windows.Forms.Form()
dlg.Text = "Component Selection"
dlg.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedDialog
dlg.MinimizeBox = False
dlg.MaximizeBox = False
dlg.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
dlg.Width = PICKER_WIDTH
dlg.Height = PICKER_HEIGHT

' Manual layout (no ClientSize)
Dim leftMargin As Integer = 12
Dim topMargin As Integer = 12
Dim innerW As Integer = PICKER_WIDTH - 2 * leftMargin - 8
Dim innerH As Integer = PICKER_HEIGHT - 120

Dim lblPrompt As New System.Windows.Forms.Label()
lblPrompt.Text = PICKER_PROMPT
lblPrompt.AutoSize = True
lblPrompt.Left = leftMargin
lblPrompt.Top = topMargin

Dim lb As New System.Windows.Forms.ListBox()
lb.Left = leftMargin
lb.Top = lblPrompt.Top + 20
lb.Width = innerW
lb.Height = innerH
lb.SelectionMode = System.Windows.Forms.SelectionMode.One
lb.Sorted = False ' already sorted
lb.Items.AddRange(labels.ToArray())
If lb.Items.Count > 0 Then lb.SelectedIndex = 0

Dim btnOK As New System.Windows.Forms.Button()
btnOK.Text = "OK"
btnOK.DialogResult = System.Windows.Forms.DialogResult.OK
btnOK.Width = 90
btnOK.Left = leftMargin + innerW - 190
btnOK.Top = lb.Top + lb.Height + 20

Dim btnCancel As New System.Windows.Forms.Button()
btnCancel.Text = "Cancel"
btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel
btnCancel.Width = 90
btnCancel.Left = leftMargin + innerW - 95
btnCancel.Top = lb.Top + lb.Height + 20

dlg.AcceptButton = btnOK
dlg.CancelButton = btnCancel

dlg.Controls.Add(lblPrompt)
dlg.Controls.Add(lb)
dlg.Controls.Add(btnOK)
dlg.Controls.Add(btnCancel)

Dim dr As System.Windows.Forms.DialogResult = dlg.ShowDialog()
If dr <> System.Windows.Forms.DialogResult.OK Then Exit Sub
If lb.SelectedItem Is Nothing Then Exit Sub
picked = CStr(lb.SelectedItem)

' Route to the correct counter
If realHits.ContainsKey(picked) Then
' REAL → occurrence count (+ optional highlight)
Dim targetDoc As Document = realHits(picked)

Dim foundOccs As New System.Collections.Generic.List(Of ComponentOccurrence)
Dim cnt As Integer = 0
For Each occ As ComponentOccurrence In oAsm.ComponentDefinition.Occurrences.AllReferencedOccurrences(targetDoc)
Try
If occ.Definition.Document.FullFileName = targetDoc.FullFileName Then
cnt += 1
foundOccs.Add(occ)
End If
Catch
End Try
Next
Dim footer As String = ""
If cnt > HIGHLIGHT_WARN_THRESHOLD Then footer = HIGHLIGHT_WARN_TEXT

Dim msg As String = vbCrLf & vbCrLf & _
"==============================" & vbCrLf & _
" QTY FOUND: " & cnt & vbCrLf & _
"==============================" & vbCrLf & vbCrLf
If footer <> "" Then msg &= footer & vbCrLf
msg &= "Would you like to highlight them?"

Dim response As MsgBoxResult = MsgBox(msg, MsgBoxStyle.YesNo + MsgBoxStyle.Information, "Count Result (Real/Assembly)")
If response = MsgBoxResult.Yes Then
Try
oAsm.SelectSet.Clear()
For Each occ As ComponentOccurrence In foundOccs
oAsm.SelectSet.Select(occ)
Next
ThisApplication.ActiveView.Fit()
Catch
End Try
End If
Exit Sub

ElseIf virtualHits.ContainsKey(picked) Then
' VIRTUAL → ask scope, then count via chosen BOM view
Dim pnPickL As String = virtualHits(picked)

Dim scopeAllLevels As Boolean = (MsgBox("Search all levels (Parts Only)?", _
MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Virtual Count Scope") = MsgBoxResult.Yes)

Dim rows As BOMRowsEnumerator = Nothing
If scopeAllLevels Then
rows = oPartsOnlyRows
Else
rows = oStructuredRows
End If

Dim totalQty As Double = 0.0
For Each oRow As BOMRow In rows
Try
Dim compDef As ComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim rowPN As String = LCase(Trim(CStr(compDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value)))
If rowPN = pnPickL Then
totalQty += oRow.TotalQuantity
End If
Catch
End Try
Next

Dim scopeNote As String = IIf(scopeAllLevels, _
"(Using manually overridden BOM quantity; includes all levels)", _
"(Using manually overridden BOM quantity; top level only)")

Dim msg As String = vbCrLf & vbCrLf & _
"==============================" & vbCrLf & _
" QTY FOUND: " & totalQty & vbCrLf & _
"==============================" & vbCrLf & vbCrLf & _
scopeNote & vbCrLf
MsgBox(msg, MsgBoxStyle.Information, "Count Result (Virtual)")
Exit Sub

Else
MessageBox.Show("Unexpected selection.", "Error")
Exit Sub
End If

End Sub