BOM in order as in the feature tree, Images to Excel document
I recently wrote a VBA script to export the BOM of the currently open assembly or drawing in Inventor 2023. This script grabs the currently active file you have open in Inventor, where after goes through all underlying subassemblies and parts. It uses the inventor object library to access your inventor instance. I dont know how to get the images out, but this atleast captures the structure of the BOM
Im sadly not able to share a real example because of my NDA, but ive made an example with placeholder data:
If you'd like to take a look at this, then see the code below:
If you are using vault, it'll ask you to check out all underlying parts. Here the script will still work with simply clicking "No to all" and then not saving the changes made to the files. Be aware of line 160, where i use formulalocal. This is because im working with danish excel function names. If you choose to use this code then remember to change this line to your local language or english excel syntax. (gentag means repeat in english). This formula will show the assembly in a hierarcal view, just like the browser tree.
Option Explicit
' A global (or module-level) collection to keep track of assemblies visited
Dim visitedAssemblies As Collection
Public Sub GenerateRecursiveBOMFromActiveInventorAssemblyV2()
Dim invApp As Inventor.Application
' Attempt to connect to a running Inventor instance
On Error Resume Next
Set invApp = GetObject(, "Inventor.Application")
On Error GoTo 0
If invApp Is Nothing Then
' Keep here in case id like to force open inventor later.
' Set invApp = CreateObject("Inventor.Application")
' invApp.Visible = True
MsgBox "Inventor was not running. Please open a valid top level assembly and try again"
' A new instance has started. " & vbCrLf & _
' "Please open an assembly in Inventor and re-run the macro.", vbInformation
Exit Sub
End If
Dim oDoc As Inventor.Document
Set oDoc = invApp.ActiveDocument
If oDoc Is Nothing Then
MsgBox "No active document in Inventor.", vbExclamation
Exit Sub
End If
' Check if the user has a
If oDoc.DocumentType <> kAssemblyDocumentObject Then
If oDoc.DocumentType = kDrawingDocumentObject Then
' MsgBox "This is a drawing, here it should change the focused document to the attached assembly"
If oDoc.ReferencedDocuments.Item(1).DocumentType = kAssemblyDocumentObject Then
Set oDoc = oDoc.ReferencedDocuments.Item(1)
' MsgBox "Great success, this found the right assembly: " + oDoc.ReferencedDocuments.Item(1).PropertySets("Design Tracking Properties").Item("Part Number").value
End If
Else
Exit Sub
End If
End If
Dim oAsmDoc As Inventor.AssemblyDocument
Set oAsmDoc = oDoc
' Get a clean name for the new sheet from the assembly
Dim asmName As String
asmName = Replace(oAsmDoc.DisplayName, ".iam", "", , , vbTextCompare)
asmName = SafeSheetName(asmName)
' Create a new sheet named after the assembly
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets.Add
On Error Resume Next
ws.Name = asmName
If Err.Number <> 0 Then
' If there's a naming conflict or invalid name, revert to a default name
Err.Clear
ws.Name = "Assembly_BOM"
End If
On Error GoTo 0
' Prepare visited assemblies collection to avoid loops
Set visitedAssemblies = New Collection
' Set up headers
With ws
.Cells.ClearContents
.Range("A1").value = "Level"
.Range("B1").value = "Item Number"
.Range("C1").value = "Part Number"
.Range("D1").value = "Description"
.Range("E1").value = "Quantity"
.Range("F1").value = "Document Name"
End With
Dim currentRow As Long
currentRow = 2
' Recursively process the BOM
WriteBOMRecursive oAsmDoc, ws, currentRow, 0
MsgBox "Full recursive BOM created on new sheet '" & ws.Name & "'.", vbInformation
' Call SymmetricDifference.FindSymmetricDifference(asmName)
End Sub
' Recursively explore sub-assemblies, writing BOM info to Excel
Private Sub WriteBOMRecursive( _
ByVal oAsmDoc As Inventor.AssemblyDocument, _
ByVal ws As Worksheet, _
ByRef currentRow As Long, _
ByVal level As Long)
Dim formulaStr As String
Dim asmKey As String
asmKey = LCase(oAsmDoc.FullFileName)
' Skip if we’ve visited it before (avoid infinite loops)
Dim visited As Variant
For Each visited In visitedAssemblies
If visited = asmKey Then
Exit Sub
End If
Next visited
' Mark this assembly as visited
visitedAssemblies.Add asmKey
' Get the BOM and configure
Dim oBOM As Inventor.BOM
Set oBOM = oAsmDoc.ComponentDefinition.BOM
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False
' If available, you might try: oBOM.StructuredViewMerged = False
Dim oBOMView As Inventor.BOMView
Set oBOMView = oBOM.BOMViews.Item("Structured")
Dim oRow As Inventor.BOMRow
For Each oRow In oBOMView.BOMRows
If oRow.ComponentDefinitions.Count = 0 Then GoTo SkipRow
Dim cDef As Inventor.ComponentDefinition
Set cDef = oRow.ComponentDefinitions.Item(1)
Dim rowDoc As Inventor.Document
Set rowDoc = cDef.Document
' Fetch iProperties
Dim PartNumber As String
Dim description As String
On Error Resume Next
PartNumber = rowDoc.PropertySets("Design Tracking Properties").Item("Part Number").value
description = rowDoc.PropertySets("Design Tracking Properties").Item("Description").value
On Error GoTo 0
' Write the row data
With ws
.Cells(currentRow, 1).value = level
.Cells(currentRow, 2).value = oRow.ItemNumber
.Cells(currentRow, 3).value = PartNumber
.Cells(currentRow, 4).value = description
.Cells(currentRow, 5).value = oRow.ItemQuantity
.Cells(currentRow, 6).value = rowDoc.DisplayName
' .Offset(0, 0) is used to convert from .Cells object to .Range object
.Cells(currentRow, 7).Offset(0, 0).FormulaLocal = "=GENTAG("" ""; A" + CStr(currentRow) + ")" + "& C" + CStr(currentRow)
End With
currentRow = currentRow + 1
' If this is a sub-assembly, recurse down
If rowDoc.DocumentType = kAssemblyDocumentObject Then
WriteBOMRecursive rowDoc, ws, currentRow, level + 1
End If
SkipRow:
Next oRow
With ws
.Columns("C").NumberFormat = "0000000"
.Columns("A:I").AutoFit
End With
End Sub
' Sanitize a string for use as an Excel worksheet name
' Excel sheet names have a 31-character limit and cannot contain certain symbols
Private Function SafeSheetName(ByVal rawName As String) As String
Dim tmp As String
tmp = Trim(rawName)
' Remove illegal characters: \ / ? * [ ] : etc.
' We'll just remove them here
Dim illegalChars As Variant
illegalChars = Array("\", "/", "?", "*", "[", "]", ":", "'")
Dim ch As Variant
For Each ch In illegalChars
tmp = Replace(tmp, ch, "")
Next ch
' Also, sheet name cannot exceed 31 chars
If Len(tmp) > 31 Then
tmp = Left(tmp, 31)
End If
' Edge case: if name is blank, default to something
If tmp = "" Then
tmp = "AssemblyBOM"
End If
SafeSheetName = tmp
End Function
This script was written to compare Inventors BOM with our ERP system for data validation. If you are interested in doing something simmilar, ive got a couple more tricks for doing this. 🙂
Hope this helps,
-Anders
