msgbox("欢迎使用本脚本！"&vbcrlf&"作者：小狼818"&vbcrlf&"QQ：542181983"&vbcrlf&"微信公众号：CATIA那点事儿"&vbcrlf&"关注获得更多资源！")

on error resume next
Set CATIA=GetObject(,"CATIA.Application")
if err.number<>0 then 
msgbox("No CATIA session found!")
wscript.quit
end if
on error goto 0


'加一些错误控制
Dim Doc
On Error Resume Next
Set Doc = CATIA.ActiveDocument
If Err.Number <> 0 Then '这里是防止在CATIA没有文件打开的情况下运行
    MsgBox ("No document opened in CATIA!")
    wscript.quit
Else
    If TypeName(Doc) <> "DrawingDocument" Then
        MsgBox ("Please run this macro with a Drawing document opened!") '这里是防止在激活的文档不是Drawing的情况下运行
        wscript.quit
    End If
End If
On Error GoTo 0


Dim lView, lBView, lSlct, lVisprp, QtyDict, TempProduct, lTable, oTable, lTexts, oParameters
Dim n, Source, Index, ProductList(50), iCt

Dim LH, LW, Fr, Mt, Wt, Num, SWt, nu, nt
Set lSlct = CATIA.ActiveDocument.Selection
Set lVisprp = lSlct.VisProperties
On Error Resume Next
Set lView = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.Item(3)
If Err.Number <> 0 Then
    MsgBox ("No user define views exsit!") '这里是防止没有视图的情况下运行
    wscript.quit
End If
On Error GoTo 0
Set lBView = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.Item("Background View")
Set lTable = lBView.Tables

On Error Resume Next '这里是防止在没有3D文档链接的情况下运行
Set oProductDoc = lView.GenerativeLinks.FirstLink
If Err.Number <> 0 Then
    MsgBox ("This drawing has no link to any 3D document!")
    wscript.quit
End If
On Error GoTo 0


Set oproducts = oProductDoc.Products
if oproducts.count=0 then
    MsgBox ("Linked 3D document is not a product, can not create detail list!")
    wscript.quit
end if

On Error Resume Next '做个提示，当明细栏已存在时，提示是更新还是取消
    Dim Tb, Stu
    Set Tb = lTable.GetItem("DetailTable")
    If Err.Number = 0 Then
        Stu = MsgBox("BOM already exsits, do you want to update informations?", vbYesNo)
        If Stu = vbNo Then
            wscript.quit
        Else
            lSlct.Add (Tb)
            lSlct.Delete
        End If
    End If
On Error GoTo 0

Set QtyDict = CreateObject("Scripting.Dictionary")
LH = CATIA.ActiveDocument.Sheets.ActiveSheet.GetPaperHeight
LW = CATIA.ActiveDocument.Sheets.ActiveSheet.GetPaperWidth
'lBView.Activate'只做视图的表格对象操作时,可以不激活该视图

Index = 1
For n = 1 To oproducts.Count
    Set TempProduct = oproducts.Item(n)
    If QtyDict.Exists(TempProduct.PartNumber) = False Then
        QtyDict.Add TempProduct.PartNumber, 1
        Set ProductList(Index) = TempProduct
        Index = Index + 1
    End If
Next

Fr=10

XOrig = LW - Fr - 180
YOrig = 56 + Fr 
Set oTable = lTable.Add(XOrig, YOrig, QtyDict.Count + 2, 8, 5, 5)

oTable.Name = "DetailTable" '给表格命名，方便获取

oTable.AnchorPoint = 2'CatTableBottomleft
oTable.MergeCells QtyDict.Count + 1, 1, 2, 1
oTable.MergeCells QtyDict.Count + 1, 2, 2, 1
oTable.MergeCells QtyDict.Count + 1, 3, 2, 1
oTable.MergeCells QtyDict.Count + 1, 4, 2, 1
oTable.MergeCells QtyDict.Count + 1, 5, 2, 1
oTable.MergeCells QtyDict.Count + 1, 8, 2, 1
oTable.MergeCells QtyDict.Count + 2, 6, 1, 2

oTable.SetCellString QtyDict.Count + 1, 1, "序号"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 1)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 1, 4

oTable.SetCellString QtyDict.Count + 1, 2, "代号"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 2)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 2, 4

oTable.SetCellString QtyDict.Count + 1, 3, "名称"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 3)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 3, 4

oTable.SetCellString QtyDict.Count + 1, 4, "数量"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 4)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 4, 4
oTable.SetCellString QtyDict.Count + 1, 5, "材料"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 5)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 5, 4

oTable.SetCellString QtyDict.Count + 2, 6, "重量/kg"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 2, 6)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 2, 6, 4

oTable.SetCellString QtyDict.Count + 1, 6, "单件"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 6)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 6, 4

oTable.SetCellString QtyDict.Count + 1, 7, "总计"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 7)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 7, 4

oTable.SetCellString QtyDict.Count + 1, 8, "备注"
Set lTexts = oTable.GetCellObject(QtyDict.Count + 1, 8)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment QtyDict.Count + 1, 8, 4

 
oTable.SetColumnSize 1, 10
oTable.SetColumnSize 2, 25
oTable.SetColumnSize 3, 40
oTable.SetColumnSize 4, 10
oTable.SetColumnSize 5, 40
oTable.SetColumnSize 6, 15
oTable.SetColumnSize 7, 15
oTable.SetColumnSize 8, 25

For n = 1 To QtyDict.Count

A = QtyDict.Count - n + 1

oTable.SetCellString A, 1, cstr(n)
Set lTexts = oTable.GetCellObject(A, 1)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 1, 4

oTable.SetCellString A, 2, ProductList(n).PartNumber
Set lTexts = oTable.GetCellObject(A, 2)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 2, 4

oTable.SetCellString A, 3, ProductList(n).Name
Set lTexts = oTable.GetCellObject(A, 3)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 3, 4

'数量
'看你之前写的,子装配应该只有1级,那就遍历一下所有子装配,看看有多少个重名的,就表示有多少个
Dim iCount, iPro
iCount = 0
For Each iPro In oproducts
    If iPro.PartNumber = ProductList(n).PartNumber Then iCount = iCount + 1
Next
oTable.SetCellString A, 4, CInt(iCount)
Set lTexts = oTable.GetCellObject(A, 4)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 4, 4

'获取材料
'防止没添加材料，加个错误控制
On Error Resume Next
Dim Prt
Set Prt = ProductList(n).ReferenceProduct.Parent.Part
Dim MatMng
Set MatMng = Prt.GetItem("CATMatManagerVBExt")
Dim Mat
MatMng.GetMaterialOnPart Prt, Mat
oTable.SetCellString A, 5, Mat.Name
Set lTexts = oTable.GetCellObject(A, 5)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 5, 4
On Error GoTo 0

oTable.SetCellString A, 6, Round(ProductList(n).Analyze.Mass, 2)
Set lTexts = oTable.GetCellObject(A, 6)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 6, 4

'总重量
'总重也只需要是单个重量*个数就可以了
oTable.SetCellString A, 7, Round(ProductList(n).Analyze.Mass, 2) * iCount
Set lTexts = oTable.GetCellObject(A, 7)
lTexts.SetFontSize 0, 0, 3.5
oTable.SetCellAlignment A, 7, 4



Next

'lView.Activate


 
复制代码