Export Largest Parts List to Excel

[emanuel.c]

I would like to export to excel the largest parts list found in a drawing. The reasoning is that if it's a weldment typically the parts list will be found on sheet 1 and it should automatically be the largest. If it's an assembly, usually at the end of the drawing we would have a parts list with a total quantity (parts only level) of all the loose parts in that assembly. As such I need to find which is the largest parts list on the drawing and export that.

The function RowNum returns the number of rows of each parts list on all sheets and it works well.

The Sub ExportPartsList also works well. Currently it's set to export the parts list from the 1st sheet, since PltoExport = 1.

I'm not sure how to capture the values from function RowNum in an array, compare them and have variable PLtoExport assigned the maximum value of that array.

Thank you for your help!

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Hey this rule only runs in drawing documents!")
		Exit Sub
	End If
	
	Dim oDrawDoc As DrawingDocument
	oDrawDoc = ThisApplication.ActiveDocument
	Dim oSheet As Sheet
	i = 1
	For Each oSheet In oDrawDoc.Sheets
	For Each oPL As PartsList In oSheet.PartsLists
		RowNum(oPL)
		Dim oSheet1 = oDrawDoc.Sheets(i)
		i = i + 1
		irows = RowNum(oPL)
		'MessageBox.Show("Parts List on Sheet: " & i & " has " & irows & " rows")
	Next	
	Next

Dim PLtoExport As Integer = 1
ExportPartsList(PLtoExport)

End Sub

Public Function RowNum(oPartsList As PartsList) As Integer
	
	Dim oPartList As PartsList
	If oPartsList Is Nothing Then Exit Function
	Dim oRows As Integer
	oRows = oPartsList.PartsListRows.Count
	Return oRows
	
End Function

Sub ExportPartsList(PLtoExport As Integer)
		
	Dim odrawDoc As DrawingDocument = ThisDoc.Document
	odrawDoc.Activate
	'get the path and name of the drawing file
	Dim fileName As String  = IO.Path.GetFileNameWithoutExtension(odrawDoc.FullFileName)
	'Logger.Info("FileName: " & fileName)
	Dim fullFileName As String = odrawDoc.FullFileName
	
	'Dim FilePath As String = Left(FullFileName, InStrRev(FullFileName, "\"))
	Dim filePath As String
	Try
		filePath = IO.Path.GetDirectoryName(odrawDoc.FullFileName) & "\"
	Catch
		MessageBox.Show("You need to save the file first!", "Error: No Filename")
		Exit Sub
	End Try
	
	Dim excelName As String = filePath & "BOM for - " & fileName & ".xlsx"
	'Logger.Info("ExcelName: " & excelName)
	
	If IO.File.Exists(excelName) Then
		'Ask to overwrite Excel File
'		Dim result As MsgBoxResult = MessageBox.Show("The Excel file already exists: " & _
'									vbCr & vbCr & excelName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", _
'									MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
'		If result = MsgBoxResult.Yes Then
			Try 'So as to overwrite.
				IO.File.Delete(excelName) 
			Catch
				MessageBox.Show("Is it perhaps opened?", "Could Not Overwrite Excel File")
				'drawDoc.Close(True)
				Exit Sub
			End Try
'		Else
'			'drawDoc.Close(True)
'			Exit Sub
'		End If
	Else
	End If

	
	'specify the drawing sheet
	oSheet = oDrawDoc.Sheets(PLtoExport) ' first sheet	
	 'say there is a Partslist on the sheet.
	oPartslist = oSheet.PartsLists(1)
     
	'Create a new NameValueMap object.
	Dim options = ThisApplication.TransientObjects.CreateNameValueMap
	
	'Specify an existing template file.
	'To use For formatting colors, fonts, etc.
	options.Value("Template") = "M:\Autodesk Inventor\Ilogic\BOM Template.xlsx"
	
	'Specify the Columns To export(all columns need to be in the partslist).
	'options.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"
	
	'Specify the start cell.
	options.Value("StartingCell") = "A" & startRow + 4
	
	'Naming the Tab in Excel	
	options.Value("TableName") = "Parts List" 
		
	'Choose to include the parts list title row.
	options.Value("IncludeTitle") = False		
	
	'Choose to autofit the column width in the xls file
	options.Value("AutoFitColumnWidth") = True
    
	'export the Partslist to Excel with options
	oPartslist.Export(excelName, PartsListFileFormatEnum.kMicrosoftExcel, options)
	'Do you want to close the document afterwards?
	'oDoc.Close(True)
	
	GoExcel.Open(excelName, options.Value("TableName"))
	GoExcel.CellValue(excelName, options.Value("TableName"), "A1") = "PARTS LIST FOR"
	GoExcel.CellValue(excelName, options.Value("TableName"), "A2") = fileName	
	GoExcel.Save
	GoExcel.Close
	
End Sub
 

[WCrihfield · Accepted solution]

Hi @emanuel.c.  I copied, then simplified and shortened the code a bit, and think I may have fixed some things along the way.  Try this version.

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Hey this rule only runs in drawing documents!")
		Exit Sub
	End If
	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets
	Dim oLongestPL As PartsList = Nothing
	Dim iMostRows As Integer = 0
	Dim iSheetNumber As Integer = 0
	For Each oSheet As Inventor.Sheet In oSheets
		Dim oPLs As PartsLists = oSheet.PartsLists
		If oPLs.Count = 0 Then Continue For
		For Each oPL As PartsList In oPLs
			If oPL.PartsListRows.Count > iMostRows Then
				iMostRows = oPL.PartsListRows.Count
				oLongestPL = oPL
				iSheetNumber = CInt(oSheet.Name.Split(":").Last)
			End If
		Next	
	Next
	ExportPartsList(oDrawDoc, oLongestPL)
End Sub

Sub ExportPartsList(oDrawDoc As DrawingDocument, oLongestPL As PartsList)
	oDrawDoc.Activate
	'get the path and name of the drawing file
	Dim fileName As String  = IO.Path.GetFileNameWithoutExtension(oDrawDoc.FullFileName)
	'Logger.Info("FileName: " & fileName)
	Dim fullFileName As String = oDrawDoc.FullFileName
	
	'Dim FilePath As String = Left(FullFileName, InStrRev(FullFileName, "\"))
	Dim filePath As String
	Try
		filePath = IO.Path.GetDirectoryName(oDrawDoc.FullFileName) & "\"
	Catch
		MessageBox.Show("You need to save the file first!", "Error: No Filename")
		Exit Sub
	End Try
	
	Dim excelName As String = filePath & "BOM for - " & fileName & ".xlsx"
	'Logger.Info("ExcelName: " & excelName)
	
	If IO.File.Exists(excelName) Then
		'Ask to overwrite Excel File
'		Dim result As MsgBoxResult = MessageBox.Show("The Excel file already exists: " & _
'									vbCr & vbCr & excelName & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", _
'									MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
'		If result = MsgBoxResult.Yes Then
			Try 'So as to overwrite.
				IO.File.Delete(excelName) 
			Catch
				MessageBox.Show("Is it perhaps opened?", "Could Not Overwrite Excel File")
				'drawDoc.Close(True)
				Exit Sub
			End Try
'		Else
'			'drawDoc.Close(True)
'			Exit Sub
'		End If
	Else
	End If
     
	'Create a new NameValueMap object.
	Dim options As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	
	'Specify an existing template file.
	'To use For formatting colors, fonts, etc.
	options.Value("Template") = "M:\Autodesk Inventor\Ilogic\BOM Template.xlsx"
	
	'Specify the Columns To export(all columns need to be in the partslist).
	'options.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION"
	
	'Specify the start cell.
	options.Value("StartingCell") = "A" & startRow + 4
	
	'Naming the Tab in Excel	
	options.Value("TableName") = "Parts List" 
		
	'Choose to include the parts list title row.
	options.Value("IncludeTitle") = False		
	
	'Choose to autofit the column width in the xls file
	options.Value("AutoFitColumnWidth") = True
    
	'export the Partslist to Excel with options
	oLongestPL.Export(excelName, PartsListFileFormatEnum.kMicrosoftExcel, options)
	'Do you want to close the document afterwards?
	'oDoc.Close(True)
	
	GoExcel.Open(excelName, options.Value("TableName"))
	GoExcel.CellValue(excelName, options.Value("TableName"), "A1") = "PARTS LIST FOR"
	GoExcel.CellValue(excelName, options.Value("TableName"), "A2") = fileName	
	GoExcel.Save
	GoExcel.Close
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[emanuel.c]

It works perfectly! Thank you for helping out!

[emanuel.c]

I tested it on a few other drawings. Sometimes I have rows hidden in the parts list. They are counted in the "oPL.PartsListRows.Count" but then only the visible rows are exported to Excel. That particular parts list with hidden rows will be used again on the last sheet of the drawing for the total quantity of loose components so it should be exported with all rows (even hidden lines).

Is there are way to export all the rows from this line of code or perhaps change the "oPL.PartsListRows.Count" to count only the visible lines? Is there a "Visible" I could use in there?

oLongestPL.Export(excelName, PartsListFileFormatEnum.kMicrosoftExcel, options)

[emanuel.c]

I modified the main Sub with this and it seems to work now, by counting only the Visible rows.

If you have any input, to make it simpler or better please share it. I always appreciate it!

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Hey this rule only runs in drawing documents!")
		Exit Sub
	End If
	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets
	Dim oLongestPL As PartsList = Nothing
	Dim iMostRows As Integer = 0
	Dim iSheetNumber As Integer = 0
	For Each oSheet As Inventor.Sheet In oSheets
		Dim oPLs As PartsLists = oSheet.PartsLists
		If oPLs.Count = 0 Then Continue For
		For Each oPL As PartsList In oPLs
			
			Dim i As Long
			Dim oVisibleRows As Integer = 0
			For i = 1 To oPL.PartsListRows.Count
			
				Dim oRow As PartsListRow
				oRow = oPL.PartsListRows.Item(i)
				If oRow.Visible = True Then
					oVisibleRows = oVisibleRows + 1
				End If
			Next
			
			If oVisibleRows > iMostRows Then
				iMostRows = oPL.PartsListRows.Count
				oLongestPL = oPL
				iSheetNumber = CInt(oSheet.Name.Split(":").Last)
			End If
		Next	
	Next
	ExportPartsList(oDrawDoc, oLongestPL)
End Sub

[WCrihfield]

I would think that this part of the code:

If oVisibleRows > iMostRows Then
	iMostRows = oPL.PartsListRows.Count
	oLongestPL = oPL
	iSheetNumber = CInt(oSheet.Name.Split(":").Last)
End If

...might need to be changed so it is not using oPL.PartsListRows.Count, and using oVisibleRows in its place, but I may b wrong in the intent there.

If oVisibleRows > iMostRows Then
	iMostRows = oVisibleRows 
	oLongestPL = oPL
	iSheetNumber = CInt(oSheet.Name.Split(":").Last)
End If

[emanuel.c]

Hmm, I don't know why but both lines seem to give the same result...

iMostRows = oPL.PartsListRows.Count

iMostRows = oVisibleRows

Thank you very much!