社区
网上找到的一段将Inventor BOM表分类导出Excel的iLogic代码，在运行规则前，确认BOM表启用了"仅零件"的BOM表视图。iLogic代码如下：
Option Explicit On
AddReference "microsoft.office.interop.excel.dll"
Imports XL = Microsoft.Office.Interop.Excel
Class BOMExport
'将字符串修改为对应的语言版本
Private Const sBOMStructureType As String = "BOM 表结构" 'BOM 表结构列字段名称
Private Const sNormal As String = "普通件"
Private Const sPurchased As String = "外购件"
Private Const sInseparable As String = "不可拆分件"
Private Const sPath As String = "C:\Temp\" 'BOM 导出路径
Private Const sFilename As String = "仅零件_" '文件名的静态部分
Private Sub Main()
'宏:
'- 装配打开中
'- 仅零件视图中不排除“零件类型”列
Dim oApp As Inventor.Application = ThisApplication
Dim oAssdoc As AssemblyDocument = oApp.ActiveDocument
Dim oBOM As BOM = oAssdoc.ComponentDefinition.BOM
Dim oBOMview As BOMView
Dim oExcelApp As XL.Application = GetObject("", "Excel.Application")
If oExcelApp Is Nothing Then
MsgBox ("无法获取 Excel")
Exit Sub
End If
oBOM.PartsOnlyViewEnabled = True
For Each oBOMview In oBOM.BOMViews
If oBOMview.ViewType = kPartsOnlyBOMViewType Then
Exit For
End If
Next
If oBOMview Is Nothing Then
MsgBox ("无法获取BOM仅零件视图")
Exit Sub
End If
If Dir(sPath & sFilename & sNormal & ".xls") <> "" Then
Call MsgBox("文件 " & sPath & sFilename & sNormal & ".xls 已存在.", vbCritical, "导出BOM")
oExcelApp.Quit
Exit Sub
ElseIf Dir(sPath & sFilename & sPurchased & ".xls") <> "" Then
Call MsgBox("文件 " & sPath & sFilename & sNormal & ".xls 已存在.", vbCritical, "导出BOM")
oExcelApp.Quit
Exit Sub
ElseIf Dir(sPath & sFilename & sInseparable & ".xls") <> "" Then
Call MsgBox("文件 " & sPath & sFilename & sNormal & ".xls 已存在.", vbCritical, "导出BOM")
oExcelApp.Quit
Exit Sub
End If
Call oBOMview.Export(sPath & sFilename & sNormal & ".xls", kMicrosoftExcelFormat, sNormal)
Call oBOMview.Export(sPath & sFilename & sPurchased & ".xls", kMicrosoftExcelFormat, sPurchased)
Call oBOMview.Export(sPath & sFilename & sInseparable & ".xls", kMicrosoftExcelFormat, sInseparable)
Dim oWB As xl.Workbook = oExcelApp.Workbooks.Open(sPath & sFilename & sNormal & ".xls")
If Not oWB Is Nothing Then
oWB = Filter(oExcelApp, oWB, sNormal)
If Not oWB Is Nothing Then
oWB.Save
End If
End If
Dim oWB2 As xl.Workbook = oExcelApp.Workbooks.Open(sPath & sFilename & sPurchased & ".xls")
If Not oWB2 Is Nothing Then
oWB2 = Filter(oExcelApp, oWB2, sPurchased)
If Not oWB2 Is Nothing Then
oWB2.Save
End If
End If
Dim oWB3 As xl.Workbook = oExcelApp.Workbooks.Open(sPath & sFilename & sInseparable & ".xls")
If Not oWB3 Is Nothing Then
oWB3 = Filter(oExcelApp, oWB3, sInseparable)
If Not oWB3 Is Nothing Then
oWB3.Save
End If
End If
Dim Result As MsgBoxResult
Result = MsgBox("导出完成. 是否查看excel?", vbYesNo, "导出BOM")
If Result = vbYes Then
oExcelApp.Visible = True
Else
For Each oWB In oExcelApp.Workbooks
oWB.Close (False)
Next
oExcelApp.Quit
End If
End Sub
Private Function Filter(ByVal oExcelApp As xl.Application , ByVal oWB As xl.Workbook, ByVal sName As String) As xl.Workbook
Dim oRange As xl.Range
Dim lLastRow As Long
Dim t As Long
oRange=oExcelApp.Cells(oWB.ActiveSheet.Rows.Count, 1)
lLastRow = oRange.End(xl.XlDirection.xlUp ).Rows.Row
Dim s As Long
s = FindColumn(oExcelApp, oWB)
If s = 0 Then
Call MsgBox("未找到BOM表结构列.", vbCritical, "导出BOM")
Filter = Nothing
Exit Function
End If
For t = lLastRow To 2 Step -1
If Not oExcelApp.Cells(t, s).Value = sName Then
Call oWB.ActiveSheet.Rows(t).Delete( Shift:=xl.XlDirection.xlUp)
End If
Next t
Return oWB
End Function
Private Function FindColumn(ByVal oExcelApp As xl.Application , ByVal oWB As xl.Workbook) As Long
Dim oRange As xl.Range
Dim lLastColumn As Long
oRange=oExcelApp.Cells(1, oWB.ActiveSheet.Columns.Count)
lLastColumn = oRange.End(xl.XlDirection.xlToLeft).Columns.Column
Dim s As Long
Dim rCells As xl.Range
For s = lLastColumn To 1 Step -1
rCells = oExcelApp.Cells(1, s)
If rCells.Value = sBOMStructureType Then
Return s
Exit For
End If
Next s
End Function
End Class
陈总也在 “Inventor俱乐部” QQ群？
If my post answers your question, please click the "Accept as Solution" button. This helps everyone find answers more quickly!
如果我的回帖解决了您的问题，请点击 "接受为解决方案" 按钮. 这可以帮助其他人更快的找到解决方案!
王 承之
Autodesk AGN [Inventor 俱乐部] Leader
Inventor Club | Bilibili
