I want the product codes of the products included in the assembly to be sorted in excel according to the material properties. At the same time, it would be perfect if it also shows how many quantity were used in the assembly. For example, the photo below.
Solved! Go to Solution.
Solved by Andrii_Humeniuk. Go to Solution.
Solved by Andrii_Humeniuk. Go to Solution.
Regards,
Arthur Knoors
Autodesk Affiliations:
Autodesk Software:Inventor Professional 2024 | Vault Professional 2022 | Autocad Mechanical 2022
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:Drawing List!|Toggle Drawing Sheet!|Workplane Resize!|Drawing View Locker!|Multi Sheet to Mono Sheet!|Drawing Weld Symbols!|Drawing View Label Align!|Open From Balloon!|Model State Lock!
Posts and Ideas:Dimension Component!|Partlist Export!|Derive I-properties!|Vault Prompts Via API!|Vault Handbook/Manual!|Drawing Toggle Sheets!|Vault Defer Update!
! For administrative reasons, please mark a "Solution as solved" when the issue is solved !
yes, I forgot, I'm sorry. I just wanted to export materials that are sheet metal.
Regards,
Arthur Knoors
Autodesk Affiliations:
Autodesk Software:Inventor Professional 2024 | Vault Professional 2022 | Autocad Mechanical 2022
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:Drawing List!|Toggle Drawing Sheet!|Workplane Resize!|Drawing View Locker!|Multi Sheet to Mono Sheet!|Drawing Weld Symbols!|Drawing View Label Align!|Open From Balloon!|Model State Lock!
Posts and Ideas:Dimension Component!|Partlist Export!|Derive I-properties!|Vault Prompts Via API!|Vault Handbook/Manual!|Drawing Toggle Sheets!|Vault Defer Update!
! For administrative reasons, please mark a "Solution as solved" when the issue is solved !
Hi @byzkc54 . I hope this is exactly what you wanted. Please check if everything works.
Sub main
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oUOM As UnitsOfMeasure = ThisApplication.UnitsOfMeasure
If TypeOf oDoc Is AssemblyDocument Then
Dim oADoc As AssemblyDocument = oDoc
Dim sPath As String = System.IO.Path.GetDirectoryName(oADoc.FullFileName)
Dim sName As String = "Sheet Metal List"
Dim sFullNameExcel As String = sPath & "\" & sName & ".xlsx"
Dim sListMaterial As New List(Of String)
sListMaterial.AddRange(GetMaterialFromAssembly(oADoc.AllReferencedDocuments, oUOM))
If sListMaterial.Count <> 0 Then
sListMaterial.Sort()
Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition
Dim oBOMView As BOMView = GetBOM_OnlyParts(oADef.BOM)
If oBOMView Is Nothing Then Exit Sub
Dim sNameAndQty As New List(Of String)
oExcel = CreateObject("Excel.Application")
If Not System.IO.File.Exists(sFullNameExcel) Then
oExcel.Visible = False
excelWorkbook = oExcel.Workbooks.Add
ExcelSheet = excelWorkbook.Worksheets(1)
ExcelSheet.Name = "Sheet1"
excelWorkbook.SaveAs(sFullNameExcel)
excelWorkbook.Close
oExcel.Quit
End If
excelWorkbook = oExcel.Workbooks.Open(sFullNameExcel)
oSheet = excelWorkbook.Worksheets(1)
oSheet.Cells.ClearContents
For iMater As Integer = 1 To sListMaterial.Count Step 1
oSheet.Cells(1, iMater).Value = sListMaterial.Item(iMater - 1)
sNameAndQty.AddRange(GetFullNameAndQty(oBOMView.BOMRows, sListMaterial.Item(iMater-1), oUOM))
sNameAndQty.Sort()
If sNameAndQty.Count <> 0 Then
For iName As Integer = 1 To sNameAndQty.Count Step 1
oSheet.Cells(iName+1, iMater).Value = sNameAndQty.Item(iName-1)
Next iName
End If
sNameAndQty.Clear()
Next iMater
oSheet.Columns.AutoFit()
excelWorkbook.Save()
excelWorkbook.Close()
End If
Else
MessageBox.Show("Active document is not AssemblyDocument", "Error!",MessageBoxButtons.OK,MessageBoxIcon.Error)
End If
End Sub
Private Function GetBOM_OnlyParts(oBOM As BOM) As BOMView
Dim sLanguageBOM As String
If Not oBOM.PartsOnlyViewEnabled Then oBOM.PartsOnlyViewEnabled = True
Select Case ThisApplication.LanguageCode
Case "en-US"
sLanguageBOM = "Parts Only"
End Select
Return oBOM.BOMViews.Item(sLanguageBOM)
End Function
Private Function GetFullNameAndQty(ByVal oBOMRows As BOMRowsEnumerator, ByVal sMatName As String, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sNameAndQty As New List(Of String)
For Each oRow As BOMRow In oBOMRows
If TypeOf oRow.ComponentDefinitions.Item(1) Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim oPartDoc As PartDocument = oSheetDef.Document
Dim sPartNumb As String = oPartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If sMaterial & " " & dThick & "mm" = sMatName Then
sNameAndQty.Add("6-01" & sPartNumb & "_" & oRow.ItemQuantity & "Qty")
End If
End If
Next
Return sNameAndQty
End Function
Private Function GetMaterialFromAssembly(ByVal oRefDocs As DocumentsEnumerator, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sListMaterial, sListFinal As New List(Of String)
For Each oRefDoc As Document In oRefDocs
If TypeOf oRefDoc Is PartDocument Then
Dim oPartDoc As PartDocument = oRefDoc
If TypeOf oPartDoc.ComponentDefinition Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oPartDoc.ComponentDefinition
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If Not sListMaterial.Contains(sMaterial & " " & dThick & "mm") Then
sListMaterial.Add(sMaterial & " " & dThick & "mm")
End If
End If
End If
Next
Return sListMaterial
End Function
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
No problem, try this code:
Sub main
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oUOM As UnitsOfMeasure = ThisApplication.UnitsOfMeasure
If TypeOf oDoc Is AssemblyDocument Then
Dim oADoc As AssemblyDocument = oDoc
Dim sPath As String = System.IO.Path.GetDirectoryName(oADoc.FullFileName)
Dim sName As String = "Sheet Metal List"
Dim sFullNameExcel As String = sPath & "\" & sName & ".xlsx"
Dim sListMaterial As New List(Of String)
sListMaterial.AddRange(GetMaterialFromAssembly(oADoc.AllReferencedDocuments, oUOM))
If sListMaterial.Count <> 0 Then
sListMaterial.Sort()
Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition
Dim oBOMView As BOMView = GetBOM_OnlyParts(oADef.BOM)
If oBOMView Is Nothing Then Exit Sub
Dim sNameAndQty As New List(Of String)
oExcel = CreateObject("Excel.Application")
If Not System.IO.File.Exists(sFullNameExcel) Then
oExcel.Visible = False
excelWorkbook = oExcel.Workbooks.Add
ExcelSheet = excelWorkbook.Worksheets(1)
ExcelSheet.Name = "Sheet1"
excelWorkbook.SaveAs(sFullNameExcel)
excelWorkbook.Close
oExcel.Quit
End If
excelWorkbook = oExcel.Workbooks.Open(sFullNameExcel)
oSheet = excelWorkbook.Worksheets(1)
oSheet.Cells.ClearContents
For iMater As Integer = 1 To sListMaterial.Count Step 1
oSheet.Cells(1, iMater).Value = sListMaterial.Item(iMater - 1)
sNameAndQty.AddRange(GetFullNameAndQty(oBOMView.BOMRows, sListMaterial.Item(iMater-1), oUOM))
sNameAndQty.Sort()
If sNameAndQty.Count <> 0 Then
For iName As Integer = 1 To sNameAndQty.Count Step 1
oSheet.Cells(iName+1, iMater).Value = sNameAndQty.Item(iName-1)
Next iName
End If
sNameAndQty.Clear()
Next iMater
oSheet.Columns.AutoFit()
excelWorkbook.Save()
excelWorkbook.Close()
End If
Else
MessageBox.Show("Active document is not AssemblyDocument", "Error!",MessageBoxButtons.OK,MessageBoxIcon.Error)
End If
End Sub
Private Function GetBOM_OnlyParts(oBOM As BOM) As BOMView
Dim sLanguageBOM As String
If Not oBOM.PartsOnlyViewEnabled Then oBOM.PartsOnlyViewEnabled = True
Select Case ThisApplication.LanguageCode
Case "en-US"
sLanguageBOM = "Parts Only"
End Select
Return oBOM.BOMViews.Item(sLanguageBOM)
End Function
Private Function GetFullNameAndQty(ByVal oBOMRows As BOMRowsEnumerator, ByVal sMatName As String, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sNameAndQty As New List(Of String)
For Each oRow As BOMRow In oBOMRows
If oRow.ItemQuantity <> 0 Then
If TypeOf oRow.ComponentDefinitions.Item(1) Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim oPartDoc As PartDocument = oSheetDef.Document
Dim sPartNumb As String = oPartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If sMaterial & " " & dThick & "mm" = sMatName Then
sNameAndQty.Add("6-01" & sPartNumb & "_" & oRow.ItemQuantity & "Qty")
End If
End If
End if
Next
Return sNameAndQty
End Function
Private Function GetMaterialFromAssembly(ByVal oRefDocs As DocumentsEnumerator, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sListMaterial, sListFinal As New List(Of String)
For Each oRefDoc As Document In oRefDocs
If TypeOf oRefDoc Is PartDocument Then
Dim oPartDoc As PartDocument = oRefDoc
If TypeOf oPartDoc.ComponentDefinition Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oPartDoc.ComponentDefinition
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If Not sListMaterial.Contains(sMaterial & " " & dThick & "mm") Then
sListMaterial.Add(sMaterial & " " & dThick & "mm")
End If
End If
End If
Next
Return sListMaterial
End Function
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.
It looks like you are using an older version of 2022 Inventor. I hope the new changes will help you.
Sub main
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oUOM As UnitsOfMeasure = ThisApplication.UnitsOfMeasure
If TypeOf oDoc Is AssemblyDocument Then
Dim oADoc As AssemblyDocument = oDoc
Dim sPath As String = System.IO.Path.GetDirectoryName(oADoc.FullFileName)
Dim sName As String = "Sheet Metal List"
Dim sFullNameExcel As String = sPath & "\" & sName & ".xlsx"
Dim sListMaterial As New List(Of String)
Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition
Dim oBOMView As BOMView = GetBOM_OnlyParts(oADef.BOM)
If oBOMView Is Nothing Then Exit Sub
sListMaterial.AddRange(GetMaterialFromAssembly(oBOMView.BOMRows, oUOM))
If sListMaterial.Count <> 0 Then
sListMaterial.Sort()
Dim sNameAndQty As New List(Of String)
oExcel = CreateObject("Excel.Application")
If Not System.IO.File.Exists(sFullNameExcel) Then
oExcel.Visible = False
excelWorkbook = oExcel.Workbooks.Add
ExcelSheet = excelWorkbook.Worksheets(1)
ExcelSheet.Name = "Sheet1"
excelWorkbook.SaveAs(sFullNameExcel)
excelWorkbook.Close
oExcel.Quit
End If
excelWorkbook = oExcel.Workbooks.Open(sFullNameExcel)
oSheet = excelWorkbook.Worksheets(1)
oSheet.Cells.ClearContents
For iMater As Integer = 1 To sListMaterial.Count Step 1
oSheet.Cells(1, iMater).Value = sListMaterial.Item(iMater - 1)
sNameAndQty.AddRange(GetFullNameAndQty(oBOMView.BOMRows, sListMaterial.Item(iMater-1), oUOM))
sNameAndQty.Sort()
If sNameAndQty.Count <> 0 Then
For iName As Integer = 1 To sNameAndQty.Count Step 1
oSheet.Cells(iName+1, iMater).Value = sNameAndQty.Item(iName-1)
Next iName
End If
sNameAndQty.Clear()
Next iMater
oSheet.Columns.AutoFit()
excelWorkbook.Save()
excelWorkbook.Close()
End If
Else
MessageBox.Show("Active document is not AssemblyDocument", "Error!",MessageBoxButtons.OK,MessageBoxIcon.Error)
End If
End Sub
Private Function GetBOM_OnlyParts(oBOM As BOM) As BOMView
Dim sLanguageBOM As String
If Not oBOM.PartsOnlyViewEnabled Then oBOM.PartsOnlyViewEnabled = True
Select Case ThisApplication.LanguageCode
Case "en-US"
sLanguageBOM = "Parts Only"
End Select
Return oBOM.BOMViews.Item(sLanguageBOM)
End Function
Private Function GetFullNameAndQty(ByVal oBOMRows As BOMRowsEnumerator, ByVal sMatName As String, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sNameAndQty As New List(Of String)
For Each oRow As BOMRow In oBOMRows
If oRow.ItemQuantity <> 0 Then
If TypeOf oRow.ComponentDefinitions.Item(1) Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim oPartDoc As PartDocument = oSheetDef.Document
Dim sPartNumb As String = oPartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If sMaterial & " " & dThick & "mm" = sMatName Then
sNameAndQty.Add("6-01" & sPartNumb & "_" & oRow.ItemQuantity & "Qty")
End If
End If
End if
Next
Return sNameAndQty
End Function
Private Function GetMaterialFromAssembly(ByVal oBOMRows As BOMRowsEnumerator, ByVal oUOM As UnitsOfMeasure) As List(Of String)
Dim sListMaterial, sListFinal As New List(Of String)
For Each oRow As BOMRow In oBOMRows
If oRow.ItemQuantity <> 0 Then
If TypeOf oRow.ComponentDefinitions.Item(1) Is SheetMetalComponentDefinition Then
Dim oSheetDef As SheetMetalComponentDefinition = oRow.ComponentDefinitions.Item(1)
Dim oPartDoc As PartDocument = oSheetDef.Document
Dim sMaterial As String = oPartDoc.ActiveMaterial.DisplayName
Dim dThick As Double = oUOM.ConvertUnits(oSheetDef.Thickness.Value, "cm", "mm")
If Not sListMaterial.Contains(sMaterial & " " & dThick & "mm") Then
sListMaterial.Add(sMaterial & " " & dThick & "mm")
End If
End If
End If
Next
Return sListMaterial
End Function
Andrii Humeniuk - Leading design engineer
LinkedIn | My free Inventor Addin | My Repositories
Did you find this reply helpful ? If so please use the Accept as Solution/Like.