06-01-2020
11:08 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-01-2020
11:08 PM
This should cover virtual components aswell ![]()
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
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website