VBA Edit BOM

[Anonymous]

I'm trying to write a VBA maacro, which when launched in an assembly will go  through the BOM and modify the part number of each component.

Some components have "." in the part number, I need to remove "." and everything after it.

I can't figure out where the "part number" property resides

Public Sub CleanWireBOM()
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    Set oBOM = asmDoc.ComponentDefinition.BOM
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True
    Dim oStructuredBOMView As BOMView
    Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")
    Dim oBOMRow As BOMRow
    
    For Each oBOMRow In oStructuredBOMView.BOMRows
        Dim oCompDef As ComponentDefinition
        Dim PartNum As String
        PartNum =  ?????
        
    Next
End Sub

[bradeneuropeArthur]

this should do:

Public Sub CleanWireBOM()
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    Set oBOM = asmDoc.ComponentDefinition.BOM
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True
    Dim oStructuredBOMView As BOMView
    Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")
    Dim oBOMRow As BOMRow
    
    For Each oBOMRow In oStructuredBOMView.BOMRows
    Dim a As Document
    Set a = oBOMRow.ComponentDefinitions.Item(1).Document
    MsgBox a.FullDocumentName
    
    Dim p As PropertySet
    Set p = a.PropertySets.Item(3)
    
    Dim pr As Property
    Set pr = p.Item("Part Number")
    Dim arr() As String
    On Error Resume Next
    arr = Split(pr.Value, ".", -1)
    Err.Clear
    pr.Value = arr(0)
    a.Save

    Next
End Sub

Because you asked the BOM iteration.

This can be different the all ref documents!! 

[MechMachineMan]

Easier to just iterate through the refdocs...

Sub Main()
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    Dim oRefDoc As Document

    For each oRefDoc in oDoc.AllReferencedDocuments
        If oRefDoc.isModifiable = True Then
            oPN = oRefDoc.PropertySets("Design Tracking Properties")("Part Number").Value
            
            Dim arr() As String

            On Error Resume Next
                arr = Split(oPN, ".", -1)
                oPN = arr(0)
            Err.Clear

            oRefDoc.PropertySets("Design Tracking Properties")("Part Number").Value = oPN
        End if
    Next
End Sub

[Anonymous]

Thank you for the quick responses. The code works well for regular parts & assemblies but not for cable/harness (which is what I was hoping to use it for).

My assembly consists of:

Connector1

Connector2

Cable1

 -> Wire1

 -> Wire2

 -> Wire3

Cable1 is set to "Phantom" in the BOM to promote the individual wires.

When I run the code with a debug statement

Debug.Print oBOMRow.ItemNumber, "-", pr.Value, vbCr

I get:

1             -             C1            

2             -             Cable1        

3             -             Cable1        

4             -             Cable1        

I guess the individual wires don't have their own "documents". So how can I access their part numbers?

Same thing happens if I add a "Virtual" component to the top level assembly. The code doesn't pick up it's part number.

I have tried setting the BOM to both "Structured" and "Parts Only" but the results is the same.

[smilinger · Accepted solution]

Try this then:

Sub CleanWireBOM()
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
    
    Dim oBom As BOM
    Set oBom = asmDoc.ComponentDefinition.BOM
    oBom.StructuredViewEnabled = True
    oBom.StructuredViewFirstLevelOnly = False
    Dim oBOMView As BOMView
    Set oBOMView = oBom.BOMViews(2)
    
    Dim compDef As ComponentDefinition
    Dim doc As Document
    Dim row As BOMRow
    Dim prop As Property
    For Each row In oBOMView.BOMRows
        Set compDef = row.ComponentDefinitions(1)
        Set doc = compDef.Document
        If compDef.Type = kVirtualComponentDefinitionObject Then
            Set prop = compDef.PropertySets("Design Tracking Properties")("Part Number")
        Else
            Set prop = doc.PropertySets("Design Tracking Properties")("Part Number")
        End If
        
        If doc.IsModifiable Then
            If prop.Value <> "" Then prop.Value = Split(prop.Value, ".")(0)
        End If
    Next
End Sub

[Anonymous]

Hello there! 

So far I haven't been able to find a tutorial or instructions on how to do a BOM modification and this thread is the closest thing I have found so far 

Please see my picture:

Basically, if we have 2 E-stops, BOM will list it as:

Main-Estop       AB          800T-FX6A5     qty            TAG1

Panel E-Stop    Blank      Blank                                  TAG2

And I basically want to do,  

Main-Estop       AB          800T-FX6A5     qty            TAG1,TAG2,TAG3 ETC......

I can do it manually but it takes a lot of time

Any help or link will be totally appreciated 

Thank you  

[lihouxin065]

I need to code by Inventor iLogic rules ，Would you do me a favor?

[A.Acheson]

Use find and replace tool to remove the word "Set".

Create a sub routine called Sub Main and set up like this. 

Sub Main
CleanWireBOM()
End Sub

[lihouxin065]

[lihouxin065]

Sub Main CleanWireBOM() End Sub Sub CleanWireBOM() Dim asmDoc As AssemblyDocument asmDoc = ThisApplication.ActiveDocument Dim oBom As BOM oBom = asmDoc.ComponentDefinition.BOM oBom.StructuredViewEnabled = True oBom.StructuredViewFirstLevelOnly = False Dim oBOMView As BOMView oBOMView = oBom.BOMViews(2) Dim compDef As ComponentDefinition Dim doc As Document Dim row As BOMRow Dim prop As Property For Each row In oBOMView.BOMRows compDef = row.ComponentDefinitions(1) doc = compDef.Document If compDef.Type = kVirtualComponentDefinitionObject Then prop = compDef.Propertys("Design Tracking Properties")("Part Number") Else prop = doc.Propertys("Design Tracking Properties")("Part Number") End If If doc.IsModifiable Then If prop.Value <> "" Then prop.Value = Split(prop.Value, ".")(0) End If Next End Sub

[A.Acheson]

A few things when posting the code you can use the special editor to keep the formatting. See below. 

So the property object needs a reference to Inventor so write it it in one of two ways

Inventor.Property

[Property]

In the find and replace of "Set" it unfortunately took it from "PropertySets" which is required.  The below code is functioning. 

Sub Main 
	CleanWireBOM() 
End Sub 
Sub CleanWireBOM()
	
	Dim asmDoc As AssemblyDocument 
	asmDoc = ThisApplication.ActiveDocument 
	
	Dim oBom As BOM 
	oBom = asmDoc.ComponentDefinition.BOM 
	
	oBom.StructuredViewEnabled = True 
	oBom.StructuredViewFirstLevelOnly = False 
	
	Dim oBOMView As BOMView 
	oBOMView = oBom.BOMViews(2) 
	
	Dim compDef As ComponentDefinition 
	Dim doc As Document 
	Dim row As BOMRow 
	Dim prop As Inventor.Property 
	
	For Each row In oBOMView.BOMRows 
		compDef = row.ComponentDefinitions(1) 
		doc = compDef.Document 
		
		If compDef.Type = kVirtualComponentDefinitionObject Then 
			prop = compDef.PropertySets("Design Tracking Properties")("Part Number") 
		Else 
			prop = doc.PropertySets("Design Tracking Properties")("Part Number") 
		End If 
		If doc.IsModifiable Then 
			If prop.Value <> "" Then prop.Value = Split(prop.Value, ".")(0) 
		End If 
	Next 
End Sub

[lihouxin065]

Thank you very much for your reply, it looks like it only works for non-virtual parts, not for wires, cables, etc.

[A.Acheson]

I think the issue is the nested sub assemblies of the structured BOM. There is no recursion on that rule so anything inside assemblies is ignored. You can use the parts only BOM and effect the parts. 

Change this line from index of 2 to 3 or use the string "Parts Only"

oBOMView = oBom.BOMViews("Parts Only") 'index 2 is "Structured",'index 3 is "Parts Only"

[lihouxin065]

Thank you for your patient guidance. After making some changes, it will also have an effect on virtual parts. The contents before the first "." from the left in the original part number are retained.

What should I do if I need to retain the content before the first "." from the right?

clear the contents enclosed by the blue curve

Sub Main 
	CleanWireBOM() 
End Sub 
Sub CleanWireBOM()
	
	Dim asmDoc As AssemblyDocument 
	asmDoc = ThisApplication.ActiveDocument 
	
	Dim oBom As BOM 
	oBom = asmDoc.ComponentDefinition.BOM 
	
	oBom.StructuredViewEnabled = True 
	oBom.StructuredViewFirstLevelOnly = False 
	oBom.PartsOnlyViewEnabled = True 
	
	Dim oBOMView As BOMView 
	oBOMView = oBom.BOMViews(3) 'index 2 is "Structured",'index 3 is "Parts Only"
	
	Dim compDef As ComponentDefinition 
	Dim doc As Document 
	Dim row As BOMRow 
	Dim prop As Inventor.Property 
	
	For Each row In oBOMView.BOMRows 
		compDef = row.ComponentDefinitions(1) 
		doc = compDef.Document 
		
		If compDef.Type = kVirtualComponentDefinitionObject Then 
			prop = compDef.PropertySets("Design Tracking Properties")("Part Number") 
		Else 
			prop = doc.PropertySets("Design Tracking Properties")("Part Number") 
		End If 
		If doc.IsModifiable Then 
			If prop.Value <> "" Then prop.Value = Split(prop.Value, ".")(0) 
		End If 
	Next 
End Sub

[A.Acheson]

You can remove the Split line and find the location of the right most deliminator then count from the left. Here is a sample. InStrRev function offical documentation

Dim TestText As String = "1234.456.789"
Dim RightDelim As Integer  = InStrRev(TestText, ".")
Dim Value As String = Left(TestText, RightDelim - 1)

 And here is how it will work in the rule. The only down side, if you run the rule twice you will remove more of the string. A work around could be to count the delimitators from the left if that is consistently 2x

If doc.IsModifiable Then 
  If prop.Value <> "" Then 
     Dim ChangeText As String = prop.Value
     Dim RightDelim As Integer  = InStrRev(ChangeText, ".")
     If RightDelim > 0 Then
	     prop.Value = Left(ChangeText, RightDelim - 1)
     End If
   End If
End If

[lihouxin065]

Thank you so much！

   The code can intercept the required characters as expected, but when dealing with the whole BOM, the wires, cables, and some virtual parts by length are merged and retaken in order, some lines are not processed after running the code.

How should I fix this problem.

before running the code

after running the code

Sub Main 
	CleanWireBOM()
	MessageBox.Show("Done", "CleanWireBOM")

End Sub 
Sub CleanWireBOM()
	
	Dim asmDoc As AssemblyDocument 
	asmDoc = ThisApplication.ActiveDocument 
	
	Dim oBom As BOM 
	oBom = asmDoc.ComponentDefinition.BOM 
	
	oBom.StructuredViewEnabled = True 
	oBom.StructuredViewFirstLevelOnly = False 
	oBom.PartsOnlyViewEnabled = True 
	
	Dim oBOMView As BOMView 
	oBOMView = oBom.BOMViews(3) 'index 2 is "Structured",'index 3 is "Parts Only"
	
	Dim compDef As ComponentDefinition 
	Dim doc As Document 
	Dim row As BOMRow 
	Dim prop As Inventor.Property 
	
	For Each row In oBOMView.BOMRows 
		compDef = row.ComponentDefinitions(1) 
		doc = compDef.Document 
		
		If compDef.Type = kVirtualComponentDefinitionObject Then 
			prop = compDef.PropertySets("Design Tracking Properties")("Part Number") 
		Else 
			prop = doc.PropertySets("Design Tracking Properties")("Part Number") 
		End If 
		If doc.IsModifiable Then 
		  If prop.Value <> "" Then 
		     Dim ChangeText As String = prop.Value
		     Dim RightDelim As Integer  = InStrRev(ChangeText, ".")
		     If RightDelim > 0 Then
			     prop.Value = Left(ChangeText, RightDelim - 1)
		     End If
		   End If
		End If
	Next 
End Sub