05-04-2023
08:24 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
05-04-2023
08:24 AM
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)