Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Hi @goran.nilssonRSJCU 

This should cover virtual components aswell :slightly_smiling_face:

 

Dim oAsm As AssemblyDocument = ThisDoc.Document
Dim Pnr As String = InputBox("Enter partnumber: ", "Search for partnumber", "000000")
Dim oList As New Dictionary(Of String, Integer)
Dim Msg As String = "Component count in Assembly/Subassemblies: " & vbCrLf
Dim pNrExists As Boolean = False
For Each oOcc As ComponentOccurrence In oAsm.ComponentDefinition.Occurrences
	If TypeOf oOcc.Definition Is VirtualComponentDefinition
		If oOcc.Definition.PropertySets("Design Tracking Properties") _
			("Part Number").Value = Pnr
			If oList.ContainsKey("Top level assembly")
				oList.Item("Top level assembly") += 1
			Else
				oList.Add("Top level assembly", 1)
			End If
			pNrExists = True
		End If
	End If
Next
For Each oDoc As Document In oAsm.AllReferencedDocuments
	If oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Or _
		oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject
		If oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject
			For Each oOcc As ComponentOccurrence In oDoc.ComponentDefinition.Occurrences
				If TypeOf oOcc.Definition Is VirtualComponentDefinition
					If oOcc.Definition.PropertySets("Design Tracking Properties") _
						("Part Number").Value = Pnr
						For Each parentOcc As ComponentOccurrence In oAsm.ComponentDefinition. _
							Occurrences.AllReferencedOccurrences(oDoc)
							If oList.ContainsKey(parentOcc.Name)
								oList.Item(parentOcc.Name) += 1
							Else
								oList.Add(parentOcc.Name, 1)
							End If
							pNrExists = True
						Next
					End If
				End If
			Next
		End If
		If oDoc.PropertySets.Item("Design Tracking Properties") _
			.Item("Part Number").Value = Pnr
			For Each oOcc As ComponentOccurrence In oAsm.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)
				pNrExists = True
				Try
					If oList.ContainsKey(oOcc.ParentOccurrence.Name)
						oList.Item(oOcc.ParentOccurrence.Name) += 1
					Else
						oList.Add(oOcc.ParentOccurrence.Name, 1)
					End If
				Catch
					If oList.ContainsKey("Top level assembly")
						oList.Item("Top level assembly") += 1
					Else
						oList.Add("Top level assembly", 1)
					End If
				End Try
			Next
		End If
	End If
Next
For Each oKey As String In oList.Keys
	Msg = Msg & oKey & " - " & oList.Item(oKey) & " st" & vbCrLf
Next
If pNrExists
	MessageBox.Show(Msg, "Found components", MessageBoxButtons.OK)
Else
	MessageBox.Show("None!", "Found components", MessageBoxButtons.OK)
End If