1.将工程图零件序号创建更改/设置为零件号。
Tools - Options -> Drafting -> Balloon Creation，此选项将自动生成部件中零件编号的零件序号。
2.在零件属性中更改/设置零件号为您需要生成在BOM表中的编号。
3.选择需要输出BOM的装配，启动程序。
e3bomV1.catvbs代码参考如下：
' bom, (c)ema, lm:13.7.2009
'
Language="VBSCRIPT"
Sub CATMain()
' ******************************* test if product is open *****************************
If CATIA.Documents.Count = 0 Then
MsgBox "There is no CATIA Documents open. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "Active CATIA Document is not a Product. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
' ******************************* variables *******************************************
Set cad = CATIA.ActiveDocument
Set sel = cad.selection
set prod=cad.Product.Products
msgboxtext="e3bom - Bill of Material"
dim tab(4,1999)
k=0
' ******************************* test if some parts is selected **********************
If sel.count =0 Then
MsgBox "No any parts for BOM is selected. Select some parts and run this script again.", ,msgboxtext
Exit Sub
End If
If sel.count >=1999 Then
MsgBox "Number of selected parts for BOM exceeds 1999. Program error.", ,msgboxtext
Exit Sub
End If
' ******************************* load ************************************************
for i=1 to prod.count
for j=1 to sel.count
if prod.item(i).name=sel.item(j).reference.name then
k=k+1
tab(1,k)=prod.item(i).PartNumber
tab(2,k)=sel.item(j).reference.name
tab(3,k)=prod.item(i).DescriptionRef
tab(4,k)=1
end if
next
next
' ******************************* sort ************************************************
if k>1 then
for i=1 to k-1
for j=i+1 to k
if tab(1,i)>tab(1,j)then
tab(1,1999)=tab(1,j)
tab(2,1999)=tab(2,j)
tab(3,1999)=tab(3,j)
tab(4,1999)=tab(4,j)
tab(1,j)=tab(1,i)
tab(2,j)=tab(2,i)
tab(3,j)=tab(3,i)
tab(4,j)=tab(4,i)
tab(1,i)=tab(1,1999)
tab(2,i)=tab(2,1999)
tab(3,i)=tab(3,1999)
tab(4,i)=tab(4,1999)
end if
next
next
' ******************************* count ***********************************************
for i=1 to k-1
for j=i+1 to k
if tab(1,i)=tab(1,j) and j<=k then
tab(1,j)=tab(1,k)
tab(2,j)=tab(2,k)
tab(3,j)=tab(3,k)
tab(4,j)=tab(4,k)
tab(4,i)=tab(4,i)+1
k=k-1
end if
next
next
end if
' ******************************* output to excel *************************************
'for i=1 to k
'msgbox i & " " & tab(1,i) & " " & tab(2,i) & " " & tab(3,i) & " " & tab(4,i)
'next
Dim xlApp
Err.Clear
On Error Resume Next
' set xlApp = GetObject(,"com.sun.star.ServiceManagerR")
set xlApp = GetObject(,"EXCEL.Application")
if Err.Number <> 0 Then
Err.Clear
' Set xlApp = CreateObject("com.sun.star.sheet")
Set xlApp = CreateObject("EXCEL.Application")
end If
xlApp.Visible = True
xlApp.Workbooks.Add
if Err.Number <> 0 Then
msgbox "Can't open excel.", ,msgboxtext
workbook.Close
xlApp.Quit
end if
row=1
col=1
xlApp.Cells(row, col+1).Value = "CATProduct:"
xlApp.Cells(row, col+1).Font.Bold = true
xlApp.Cells(row+1, col+1).Value = cad.name
row=4
xlApp.Cells(row, col+1).Value = "SR.NO."
xlApp.Cells(row, col+2).Value = "PART NO."
xlApp.Cells(row, col+3).Value = "DESCRIPTION"
xlApp.Cells(row, col+4).Value = "QNT."
xlApp.Columns.Columns(3).Columnwidth = 30
xlApp.Columns.Columns(4).Columnwidth = 50
for i=1 to 4
xlApp.Cells(row,col+i).Interior.ColorIndex = 40
xlApp.Cells(row,col+i).Font.Bold = true
xlApp.Cells(row,col+i).HorizontalAlignment = 3
xlApp.Cells(row,col+i).borders.LineStyle = 1
xlApp.Cells(row,col+i).borders.weight = -4138
next
' row=row+1
for i=1 to k
xlApp.Cells(row+i,col+1).Value = tab(1,i)
xlApp.Cells(row+i,col+2).Value = tab(2,i)
xlApp.Cells(row+i,col+3).Value = trim(tab(3,i))
xlApp.Cells(row+i,col+4).Value = tab(4,i)
for j=1 to 4
xlApp.Cells(row+i,col+j).Interior.ColorIndex = 19
xlApp.Cells(row+i,col+j).Font.Bold = false
xlApp.Cells(row+i,col+j).borders.LineStyle = 1
next
next
xlApp.Cells(row+i,col).Select
' xlApp.Cells(1, 1).HorizontalAlignment = 2
End Sub
e3bomV2.catvbs 代码参考如下：
' bom, (c)ema, lm:20.7.2009
'
Language="VBSCRIPT"
Sub CATMain()
' ******************************* test if product is open *****************************
If CATIA.Documents.Count = 0 Then
MsgBox "There is no CATIA Documents open. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "Active CATIA Document is not a Product. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
' ******************************* variables *******************************************
Set objNetwork = CreateObject("Wscript.Network")
Set cad = CATIA.ActiveDocument
Set sel = cad.selection
set prod=cad.Product.Products
msgboxtext="e3bom - Bill of Material"
dim tab(5,1999)
k=0
' ******************************* test if some parts is selected **********************
If sel.count =0 Then
MsgBox "No any parts for BOM is selected. Select some parts and run this script again.", ,msgboxtext
Exit Sub
End If
If sel.count >=1999 Then
MsgBox "Number of selected parts for BOM exceeds 1999. Program error.", ,msgboxtext
Exit Sub
End If
' ******************************* load ************************************************
for i=1 to prod.count
for j=1 to sel.count
if prod.item(i).name=sel.item(j).reference.name then
k=k+1
tab(2,k)=prod.item(i).PartNumber
tab(1,k)=sel.item(j).reference.name
tab(3,k)=prod.item(i).DescriptionRef
tab(4,k)=1
tab(5,k)=prod.item(i).Nomenclature
end if
next
next
' ******************************* sort ************************************************
if k>1 then
for i=1 to k-1
for j=i+1 to k
if tab(1,i)>tab(1,j)then
tab(1,1999)=tab(1,j)
tab(2,1999)=tab(2,j)
tab(3,1999)=tab(3,j)
tab(4,1999)=tab(4,j)
tab(5,1999)=tab(5,j)
tab(1,j)=tab(1,i)
tab(2,j)=tab(2,i)
tab(3,j)=tab(3,i)
tab(4,j)=tab(4,i)
tab(5,j)=tab(5,i)
tab(1,i)=tab(1,1999)
tab(2,i)=tab(2,1999)
tab(3,i)=tab(3,1999)
tab(4,i)=tab(4,1999)
tab(5,i)=tab(5,1999)
end if
next
next
' ******************************* count ***********************************************
for i=1 to k-1
for j=i+1 to k
if tab(1,i)=tab(1,j) and j<=k then
tab(1,j)=tab(1,k)
tab(2,j)=tab(2,k)
tab(3,j)=tab(3,k)
tab(4,j)=tab(4,k)
tab(4,i)=tab(4,i)+1
tab(5,j)=tab(5,k)
k=k-1
end if
next
next
end if
' ******************************* output to excel *************************************
'for i=1 to k
'msgbox i & " " & tab(1,i) & " " & tab(2,i) & " " & tab(3,i) & " " & tab(4,i)
'next
Dim xlApp
err.Clear
On Error Resume Next
' set xlApp = GetObject(,"com.sun.star.ServiceManagerR")
set xlApp = GetObject(,"EXCEL.Application")
if Err.Number <> 0 Then
Err.Clear
' Set xlApp = CreateObject("com.sun.star.sheet")
Set xlApp = CreateObject("EXCEL.Application")
end If
xlApp.Visible = True
xlApp.Workbooks.Add
if Err.Number <> 0 Then
msgbox "Can't open excel.", ,msgboxtext
workbook.Close
xlApp.Quit
end if
row=4
col=0
xlApp.Cells(row,col+3).Value = "LH UNIT-BOM"
xlApp.Cells(row,col+3).borders.LineStyle = 1
xlApp.Cells(row,col+3).borders.Weight = 3
xlApp.Cells(row,col+3).HorizontalAlignment = 3
xlApp.Cells(row,col+9).Value = "RH UNIT-BOM"
xlApp.Cells(row,col+9).borders.LineStyle = 1
xlApp.Cells(row,col+9).borders.Weight = 3
xlApp.Cells(row,col+9).HorizontalAlignment = 3
row=7
xlApp.Cells(row, col+1).Value = "UNIT CODE"
xlApp.Cells(row+1, col+1).Value = "UNIT DESCRIPTION"
xlApp.Cells(row+2, col+1).Value = "PARENT CODE"
xlApp.Cells(row+3, col+1).Value = "PARENT DESCRIPTION"
xlApp.Cells(row, col+3).Value = cad.Product.PartNumber
xlApp.Cells(row+1, col+3).Value = cad.Product.DescriptionRef
xlApp.Cells(row, col+7).Value = "UNIT CODE"
xlApp.Cells(row+1, col+7).Value = "UNIT DESCRIPTION"
xlApp.Cells(row+2, col+7).Value = "PARENT CODE"
xlApp.Cells(row+3, col+7).Value = "PARENT DESCRIPTION"
xlApp.Cells(row, col+9).Value = cad.Product.PartNumber
xlApp.Cells(row+1, col+9).Value = cad.Product.DescriptionRef
for i=1 to 4
xlApp.Range("A" & row-1+i & ":B" & row-1+i).MergeCells = True
xlApp.Range("A" & row-1+i & ":B" & row-1+i).borders.LineStyle = 1
xlApp.Range("A" & row-1+i & ":B" & row-1+i).Font.Bold = true
xlApp.Range("G" & row-1+i & ":H" & row-1+i).MergeCells = True
xlApp.Range("G" & row-1+i & ":H" & row-1+i).borders.LineStyle = 1
xlApp.Range("G" & row-1+i & ":H" & row-1+i).Font.Bold = true
xlApp.Range("C" & row-1+i & ":E" & row-1+i).MergeCells = True
xlApp.Range("C" & row-1+i & ":E" & row-1+i).borders.LineStyle = 1
xlApp.Range("C" & row-1+i & ":E" & row-1+i).HorizontalAlignment = 3
xlApp.Range("I" & row-1+i & ":K" & row-1+i).MergeCells = True
xlApp.Range("I" & row-1+i & ":K" & row-1+i).borders.LineStyle = 1
xlApp.Range("I" & row-1+i & ":K" & row-1+i).HorizontalAlignment = 3
next
row=12
xlApp.Cells(row, col+1).Value = "SR.NO."
xlApp.Cells(row, col+2).Value = "PART NO."
xlApp.Cells(row, col+3).Value = "DESCRIPTION"
xlApp.Cells(row, col+4).Value = "QTY."
xlApp.Cells(row, col+5).Value = "REMARK"
xlApp.Cells(row, col+7).Value = "SR.NO."
xlApp.Cells(row, col+8).Value = "PART NO."
xlApp.Cells(row, col+9).Value = "DESCRIPTION"
xlApp.Cells(row, col+10).Value ="QTY."
xlApp.Cells(row, col+11).Value ="REMARK"
xlApp.Columns.Columns(1).Columnwidth = 8
xlApp.Columns.Columns(2).Columnwidth = 15
xlApp.Columns.Columns(3).Columnwidth = 15
xlApp.Columns.Columns(4).Columnwidth = 6
xlApp.Columns.Columns(7).Columnwidth = 8
xlApp.Columns.Columns(8).Columnwidth = 15
xlApp.Columns.Columns(9).Columnwidth = 15
xlApp.Columns.Columns(10).Columnwidth = 6
for i=1 to 11
' xlApp.Cells(row,col+i).Interior.ColorIndex = 40
if(i<>6)then
xlApp.Cells(row,col+i).Font.Bold = true
xlApp.Cells(row,col+i).HorizontalAlignment = 3
xlApp.Cells(row,col+i).borders.LineStyle = 1
xlApp.Cells(row,col+i).borders.weight = -4138
end if
next
' row=row+1
for i=1 to k
xlApp.Cells(row+i,col+1).Value = tab(1,i)
xlApp.Cells(row+i,col+2).Value = tab(2,i)
xlApp.Cells(row+i,col+3).Value = trim(tab(3,i))
xlApp.Cells(row+i,col+4).Value = tab(4,i)
xlApp.Cells(row+i,col+7).Value = tab(1,i)
xlApp.Cells(row+i,col+8).Value = tab(5,i)
xlApp.Cells(row+i,col+9).Value = trim(tab(3,i))
xlApp.Cells(row+i,col+10).Value = tab(4,i)
for j=1 to 11
' xlApp.Cells(row+i,col+j).Interior.ColorIndex = 19
xlApp.Cells(row+i,col+j).Font.Bold = false
if(j<>6)then xlApp.Cells(row+i,col+j).borders.LineStyle = 1
xlApp.Cells(row+i,col+j).HorizontalAlignment = 3
next
next
xlApp.Cells(1,1).Select
.MergeCells = True
'With xlApp.Selection
'.HorizontalAlignment = xlCenter
'.MergeCells = True
'End With
'xlApp.Cells(1, 1).HorizontalAlignment = 2
'xlApp.Activate
'xlApp.Unprotect
'xlApp.Range(4, 3).HorizontalAlignment = xlCenter
'xlApp.Selection.HorizontalAlignment = xlCenter
'xlApp.ActiveWorkbook.ActiveSheet.Range("A1:D4").HorizontalAlignment = xlCenter
End Sub
e3bomVolumes.catvbs 代码参考如下：
' BOM - volume & cog, (c) ema, lm:30.10.2009, V1
'
dbg=true
dbg=false
'
Language="VBSCRIPT"
Sub CATMain()
' ******************************* variables *******************************************
' CATIA.DisplayFileAlerts =false
Set objNetwork = CreateObject("Wscript.Network")
msgboxtext="BOM - volume & cog"
' set csc = CATIA.SettingControllers
' set visualizationSettingAtt1 = csc.Item("CATVizVisualizationSettingCtrl")
dim cog(2)
Dim xlApp
err.Clear
On Error Resume Next
set xlApp = GetObject(,"EXCEL.Application")
if Err.Number <> 0 Then
Err.Clear
Set xlApp = CreateObject("EXCEL.Application")
end If
xlApp.Visible = True
xlApp.Workbooks.Add
if Err.Number <> 0 Then
msgbox "Can't open excel.",,msgboxtext
workbook.Close
xlApp.Quit
exit sub
end if
row=1
col=1
xlApp.Cells(1,4).Select
xlApp.Columns.Columns(col+0).Columnwidth = 22
xlApp.Columns.Columns(col+1).Columnwidth = 10
xlApp.Columns.Columns(col+2).Columnwidth = 10
xlApp.Columns.Columns(col+3).Columnwidth = 10
xlApp.Columns.Columns(col+4).Columnwidth = 10
xlApp.Cells(row,col+0).Value = msgboxtext
' xlApp.Cells(row,col+0).borders.LineStyle = 1
' xlApp.Cells(row,col+0).borders.Weight = 3
' xlApp.Cells(row,col+0).HorizontalAlignment = 3
xlApp.Cells(row,col+0).Font.Bold = true
row=row+2
xlApp.Cells(row,col+0).Value = "Main product name: " & CATIA.ActiveDocument.name
' xlApp.Cells(row,col+0).borders.LineStyle = 1
' xlApp.Cells(row,col+0).borders.Weight = 3
' xlApp.Cells(row,col+0).HorizontalAlignment = 3
xlApp.Cells(row,col+0).Font.Bold = true
' xlApp.Cells(row,col+0).Interior.ColorIndex = 40
row=row+2
xlApp.Cells(row,col+0).Value = "name"
xlApp.Cells(row,col+1).Value = "volume"
xlApp.Cells(row,col+2).Value = "X"
xlApp.Cells(row,col+3).Value = "Y"
xlApp.Cells(row,col+4).Value = "Z"
xlApp.Cells(row,col+0).HorizontalAlignment = 3
xlApp.Cells(row,col+1).HorizontalAlignment = 3
xlApp.Cells(row,col+2).HorizontalAlignment = 3
xlApp.Cells(row,col+3).HorizontalAlignment = 3
xlApp.Cells(row,col+4).HorizontalAlignment = 3
xlApp.Cells(row,col+0).Font.Bold = true
xlApp.Cells(row,col+1).Font.Bold = true
xlApp.Cells(row,col+2).Font.Bold = true
xlApp.Cells(row,col+3).Font.Bold = true
xlApp.Cells(row,col+4).Font.Bold = true
row=row+1
' ******************************* test if product is open *****************************
If CATIA.Documents.Count = 0 Then
MsgBox "There is no CATIA Documents open. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "Active CATIA Document is not a Product. Open a Product file and run this script again.", ,msgboxtext
Exit Sub
End If
' ******************************* go **************************************************
set cad=CATIA.ActiveDocument
Set spa=cad.GetWorkbench("SPAWorkbench")
set docs=CATIA.Documents
set prod = cad.Product
set prods = prod.Products
for i=1 to prods.count
prods.item(i).Analyze.GetGravityCenter cog
vol=prods.item(i).Analyze.Volume
prtNum =prods.Item(i).PartNumber
' msgbox "Name: " & prtNum & " Volume:" & vol & " COG: " & join(cog)
xlApp.Cells(row,col+0).Value = prtNum
xlApp.Cells(row,col+1).Value = vol
xlApp.Cells(row,col+2).Value = cog(0)
xlApp.Cells(row,col+3).Value = cog(1)
xlApp.Cells(row,col+4).Value = cog(2)
row=row+1
next
'prtNum =prods.Item(2).PartNumber
'prtName=prods.Item(2).Name
'msgbox prtName & "/!" & prtName
'Set reference1 = prod.CreateReferenceFromName(prtNum & "/!" & prtName & "/" )
'set M0=spa.GetMeasurable(reference1)
'vol=M0.Volume
'msgbox vol
' msgbox "end of execution." ,,msgboxtext
' *************************************************************************************
' ******************************* E N D *********************************************
' *************************************************************************************
End Sub
网友评论