I'm apreciate your help. Basicly there is nothing to upload. Your code is working perfect what i need, but i would like to upgrade code even more. How to recognise Library parts (Vaut) and not count them into PartQty. That will be it. I tried what you suggest but without success.
Thank you
Sub Main
doc = ThisDoc.Document
Dim oAssyDef As AssemblyComponentDefinition = doc.ComponentDefinition
Dim oBOM As BOM = oAssyDef.BOM
oBOM.PartsOnlyViewEnabled = True
Dim oBOMViewPO As BOMView = oBOM.BOMViews.Item("Parts Only")
Dim oBOMRowPO As BOMRow
For Each oBOMRowPO In oBOMViewPO.BOMRows
'Set a reference to the primary ComponentDefinition of the row
Dim oCompDef As ComponentDefinition
oCompDef = oBOMRowPO.ComponentDefinitions.Item(1)
Dim CompFullDocumentName As String = oCompDef.Document.FullDocumentName
Dim CompFileNameOnly As String
Dim index As Integer = CompFullDocumentName.lastindexof("\")
CompFileNameOnly = CompFullDocumentName.substring(index+1)
'MessageBox.Show(CompFileNameOnly)
Dim Qty As String
Qty = oBOMRowPO.TotalQuantity
iProperties.Value(CompFileNameOnly, "Custom", "PartQty") = Qty
Next
If oBOM.StructuredViewEnabled Then
If oBOM.StructuredViewFirstLevelOnly Then
oBOM.StructuredViewFirstLevelOnly = False
End If
Else
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False
End If
Dim oBOMViewStruc As BOMView = oBOM.BOMViews.Item("Structured")
Dim oBOMRowStruc As BOMRow
Dim arrSubAssemblyList As New ArrayList
Call QueryBOMRowProperties(oBOMViewStruc.BOMRows, arrSubAssemblyList, 1)
End Sub
Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, arrSubAssembly As ArrayList, oParentQty As Integer)
Dim i As Long
For i = 1 To oBOMRows.count
Dim oBOMRowStruc As BOMRow = oBOMRows.item(i)
Dim oCompDef As ComponentDefinition = oBOMRowStruc.ComponentDefinitions.item(1)
Dim oQty As Integer
If TypeOf oCompDef Is AssemblyComponentDefinition And oCompDef.BOMStructure = BOMStructureEnum.kNormalBOMStructure Then
Dim CompFullDocumentName As String = oCompDef.Document.FullDocumentName
Dim CompFileNameOnly As String
Dim index As Integer = CompFullDocumentName.lastindexof("\")
CompFileNameOnly = CompFullDocumentName.substring(index+1)
'MessageBox.Show(CompFileNameOnly)
oQty = oBOMRowStruc.ItemQuantity * oParentQty
Dim additionalQty As Integer
If arrSubAssembly.Count <> 0 Then
Dim counter As Integer
For Each CompData As String In arrSubAssembly
Dim commaindex As Integer = CompData.indexof(",")
Dim CompName As String = CompData.substring(0,commaindex)
If CompName = CompFileNameOnly Then
additionalQty = CompData.substring(commaindex+1)
Else
counter += 1
End If
Next
If additionalQty = 0 Then
arrSubAssembly.add(CompFileNameOnly & "," & oQty)
Else
arrSubAssembly(counter) = CompFileNameOnly & "," & oQty + additionalQty
End If
Else
arrSubAssembly.add(CompFileNameOnly & "," & oQty)
End If
iProperties.Value(CompFileNameOnly, "Custom", "PartQty") = oQty + additionalQty
'Recursively iterate child rows if present.
If Not oBOMRowStruc.ChildRows Is Nothing Then
Call QueryBOMRowProperties(oBOMRowStruc.ChildRows, arrSubAssembly, oQty)
End If
End If
Next
End Sub