I commented out the GetBOMQuantityAndWriteToExcel() method (line 91) and added the AllReferencedOccurrences() method (lines 92-93). I hope the changes will help you.
Imports Excel = Microsoft.Office.Interop.Excel
'This ilogic is written to export specific .ipt files with a name (example -PI) to STP & JPG.
'Choose which documents should be exported.
'An Excel file must be created from the exported files in which various properties are created (Title / Subject / Number, etc.)
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
MsgBox("An Assembly Document must be active for this rule to work. Exiting.", vbCritical, "iLogic")
Exit Sub
End If
' Set the filenames to export
Dim oMyParamFileName = InputBox("Welke Parts moeten worden geexporteerd, geef een gedeelte van de Filenaam op, bijvoorbeeld:", "Filename", "-PI-")
' Set Date
Dim oMyDate = DateTime.Now.ToString("yyyyMMdd")
Dim oADoc As Inventor.AssemblyDocument = ThisDoc.Document
Dim oOccs As ComponentOccurrences = oADoc.ComponentDefinition.Occurrences
Dim oPath As String = ThisDoc.Path
Dim oAsmName As String = ThisDoc.FileName(False) 'without extension
Dim oPIDocs As List(Of Inventor.Document) 'not initiated yet
Dim oContinue = MsgBox("Do you want to process this whole assembly now?" & vbCrLf & _
"Yes = PROCESS ALL LEVELS" & vbCrLf & _
"No = Process Top Level Only" & vbCrLf & _
"Cancel = Exit Rule Without Proceeding", vbYesNoCancel + vbQuestion, "Export files to .step & .jpg by name?")
If oContinue = vbCancel Then Exit Sub
If oContinue = vbYes Then 'process all level
oPIDocs = oADoc.AllReferencedDocuments.Cast(Of Inventor.Document).Where(Function(Doc) Doc.DisplayName.Contains(oMyParamFileName)).ToList
ElseIf oContinue = vbNo Then 'process top levels only
oPIDocs = oADoc.ReferencedDocuments.Cast(Of Inventor.Document).Where(Function(Doc) Doc.DisplayName.Contains(oMyParamFileName)).ToList
End If
If IsNothing(oPIDocs) OrElse oPIDocs.Count = 0 Then
MsgBox("No documents found for the specified criteria. Exiting.", vbInformation, "iLogic")
Exit Sub
End If
' Set folder name
Dim oMyParamFilePath = InputBox("Vul hier de mapnaam in waar de files in komen, bijvoorbeeld:", "Mapnaam = Assembly Nr. + opgegeven naam", "Piping")
' Set folder
Dim oFolder As String = oPath & "\" & oAsmName & " " & oMyParamFilePath & " " & oMyDate & "\"
If Not System.IO.Directory.Exists(oFolder) Then System.IO.Directory.CreateDirectory(oFolder)
' Set the path for the Excel template file
Dim excelTemplatePath As String = "C:\VaultWerkmap\Templates en settings\Templates\PipingTemplate r00.xltx"
' Create a new Excel application
Dim excelApp As Object = CreateObject("Excel.Application")
' Make Excel visible for debugging purposes
excelApp.Visible = True
' Open the Excel template
Dim workbookTemplate As Object = excelApp.Workbooks.Open(excelTemplatePath)
' Select the first worksheet
Dim worksheet As Object = workbookTemplate.Sheets(1)
' Write the header to the Excel sheet
worksheet.Cells(1, 1).Value = "File Name"
worksheet.Cells(1, 2).Value = "Title"
worksheet.Cells(1, 3).Value = "Subject"
worksheet.Cells(1, 4).Value = "Revision Number"
worksheet.Cells(1, 5).Value = "Material"
worksheet.Cells(1, 8).Value = "BOM Quantity" ' New column for BOM Quantity
' Declare userParamsToFind at the beginning of Sub Main
Dim userParamsToFind As List(Of String) = New List(Of String) From {"Bendradius", "FormType"}
' Specify user parameters to find and write to Excel sheet
Dim rowNum As Integer = 2 ' Initialize rowNum before the loop
For i = 0 To userParamsToFind.Count - 1
' Write user parameter details to Excel sheet
WriteUserParamToExcel(oPIDocs, userParamsToFind(i), worksheet, 1, rowNum, i + 6)
Next
For Each oPIDoc In oPIDocs
' Setting the file NameProperties
Dim oTitleProp = oPIDoc.PropertySets("Summary Information").Item("Title").Value
Dim oSubjectProp = oPIDoc.PropertySets("Summary Information").Item("Subject").Value
Dim oRevProp = oPIDoc.PropertySets("Summary Information").Item("Revision Number").Value
Dim oRevnr = "r"
Dim oFileName As String = System.IO.Path.GetFileNameWithoutExtension(oPIDoc.FullFileName)
' Call the Subroutine to get BOM quantity and write to Excel
' GetBOMQuantityAndWriteToExcel(oPIDoc, worksheet, rowNum, 😎 ' Assuming the next available column is 8
Dim iQTY As Integer = oOccs.AllReferencedOccurrences(oPIDoc).Count
worksheet.Cells(rowNum, 8).Value = iQTY
' Extract iProperties
Dim fileName As String = oFileName
Dim title As String = oTitleProp
Dim subject As String = oSubjectProp
Dim revisionNumber As String = oRevnr & oRevProp
Dim oMatName As String = oPIDoc.ComponentDefinition.Material.Name
' Write data to the Excel sheet
worksheet.Cells(rowNum, 1).Value = fileName
worksheet.Cells(rowNum, 2).Value = title
worksheet.Cells(rowNum, 3).Value = subject
worksheet.Cells(rowNum, 4).Value = revisionNumber
worksheet.Cells(rowNum, 5).Value = oMatName
' Increment rowNum for the next iteration
rowNum += 1
' Export to .step and .jpg
Dim oFilePropsName As String = oFolder & oFileName & " " & oTitleProp & " " & oSubjectProp & " " & oRevnr & oRevProp & " " & oMyDate
Dim oSTEPFile As String = oFilePropsName & ".stp"
Dim oJPGFile As String = oFilePropsName & ".jpg"
'oPIDoc.SaveAs(oSTEPFile, False) 'or use alternative below
ExportToSTEP(oPIDoc, oSTEPFile)
oPIDoc.SaveAs(oJPGFile, True)
Next
' Save the modified Excel template
Dim excelResultPath As String = oFolder & oAsmName & " Piping " & oMyDate & ".xlsx"
workbookTemplate.SaveAs(excelResultPath)
workbookTemplate.Close()
' Ask the user if they want to open the export folder
Dim OpenFolder = MessageBox.Show("Export successful! " & _
"- open containing folder now?", "Open Folder", _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If OpenFolder = vbYes Then
Process.Start("explorer.exe", oFolder)
End If
End Sub
Sub WriteUserParamToExcel(oPIDocs As List(Of Inventor.Document), userParamNameToFind As String, worksheet As Object, headerRow As Integer, startRow As Integer, colIndex As Integer)
' Write header for user parameter to Excel sheet
worksheet.Cells(headerRow, colIndex).Value = userParamNameToFind
Dim rowNum As Integer = startRow ' Start from the specified row for data
For Each oPiDoc In oPIDocs
' Find the user parameter in oPiDoc
Dim userParamToFind As Parameter = Nothing
For Each param As Parameter In oPiDoc.ComponentDefinition.Parameters
If param.Name = userParamNameToFind Then
userParamToFind = param
Exit For
End If
Next
' Check if the user parameter was found in oPiDoc
If Not userParamToFind Is Nothing Then
' Retrieve the value of the user parameter
Dim userParamValueToFind As Object = userParamToFind.Value
' Write user parameter details to Excel sheet
worksheet.Cells(rowNum, colIndex).Value = userParamValueToFind.ToString()
Else
' User parameter not found in oPiDoc
MsgBox("User Parameter '" & userParamNameToFind & "' not found in the current document.", MsgBoxStyle.Information, "iLogic")
End If
' Increment rowNum for the next iteration
rowNum += 1
Next
End Sub
Sub ExportToSTEP(oDoc As Document, oNewFileName As String)
Dim oSTEP As TranslatorAddIn
oSTEP = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
If IsNothing(oSTEP) Then
Logger.Debug("STEP Translator Add-in not found.")
Exit Sub
End If
Dim oTO As TransientObjects = ThisApplication.TransientObjects
Dim oContext As TranslationContext = oTO.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oOptions As NameValueMap = oTO.CreateNameValueMap
Dim oDataMedium As DataMedium = oTO.CreateDataMedium
If System.IO.File.Exists(oNewFileName) Then
Dim oAns = MsgBox("A STEP file with this name already exists." & vbCrLf &
oNewFileName & vbCrLf & _
"Do you want to overwrite it with this new one?", vbYesNo + vbQuestion + vbDefaultButton2, "STEP FILE EXISTS")
If oAns = vbNo Then Exit Sub
End If
oDataMedium.FileName = oNewFileName
If oSTEP.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
' Set application protocol.
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 3
oOptions.Value("IncludeSketches") = True
oOptions.Value("export_fit_tolerance") = 0.000393701 'minimum
oOptions.Value("Author") = ThisApplication.GeneralOptions.UserName
'oOptions.Value("Authorization") = ""
'oOptions.Value("Description") = oDoc.PropertySets.Item(3).Item("Description").Value
'oOptions.Value("Organization") = oDoc.PropertySets.Item(2).Item("Company").Value
Try
oSTEP.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
Catch ex As Exception
Logger.Error("Error exporting following document to STEP:" & vbCrLf & oDoc.FullDocumentName & vbCrLf & ex.Message)
End Try
End If
End Sub
Sub GetBOMQuantityAndWriteToExcel(oPIDoc As Document, worksheet As Object, rowNum As Integer, colIndex As Integer)
' Check if the document has a BOM
If oPIDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim asmDoc As AssemblyDocument = oPIDoc
Dim oBOMViews As BOMViews = asmDoc.ComponentDefinition.BOM.BOMViews
' Iterate through all BOM views
For Each bomView As BOMView In oBOMViews
' Iterate through the BOM rows of each BOM view
For Each bomRow As BOMRow In BOMView.BOMRows
' Check if the component is the specified document
If BOMRow.ComponentDefinitions(1).Document.FullFileName = oPIDoc.FullFileName Then
' Accumulate the total quantity for all occurrences
worksheet.Cells(rowNum, colIndex).Value = BOMRow.ItemQuantity
Exit Sub ' Exit the loop once the quantity is found
End If
Next
Next
End If
' If no BOM quantity is found, set it to 0
worksheet.Cells(rowNum, colIndex).Value = 0
End Sub