- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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)
.
Wesley Crihfield
(Not an Autodesk Employee)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Wesley Crihfield
(Not an Autodesk Employee)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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!