CATIA v5 VBA：自定义 BOM 宏将 UserRefProperties 插入 table
CATIA v5 VBA: Custom BOM Macro inserting UserRefProperties into table
我想创建自定义 BOM，我在 coe.org 论坛上找到了一个宏（请参阅 post 底部）。
我在按照我的要求实施它时遇到了一些困难。
在某些时候宏使用代码：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).PartNumber)
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
我测试了宏并且它有效，但是我想写一些用户定义的属性的值而不是预设的 CATIA 属性。
因此我将代码更改为：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
当我再次执行宏时，出现错误：
Automation error
Unspecified error
我是编程新手，但我用过
...Product.UserRefProperties.Item("CE_NUMBER")
在我的标题栏之前，它确实在那里工作。我尝试了多种变体，例如
ProductList(n).CE_NUMBER
但我无法让它工作。
我回溯了 Productlist(n)，它的声明如下：
Dim ProductList(50) As Product
据我所知，它应该 return 以 .Product 结尾的同一种东西，就像我标题栏中的代码一样。
任何人都知道如何让这个宏做我想做的事？
提前致谢。
从coe.org复制的原始宏代码（缺少几个字符）：
Option Explicit
Sub CATMain()
On Error Resume Next
'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant
Dim Width As Integer
Dim height As Integer
Dim xOffset As Integer
Dim yOffset As Integer
Dim XOrig As Integer
Dim YOrig As Integer
'Check that the ActiveDocument is a CATDrawing.
'If not, inform the user and terminate execution.
Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) "CATDrawing" Then
MsgBox "This utility must be executed from a within a CATDrawing."
Exit Sub
End If
'Populate the Variables
Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View"
Set oDrawingTables = oBackgroundView.Tables
Err.Clear
'Check that the linked document is a product and not a part
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
If Err.Number 0 Then
MsgBox "The linked model is not a product!", vbExclamation
Exit Sub
End If
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary"
'get the sheet dimensions so that we can place the bom in the right
'place relative to the drawing border
xOffset = -90
yOffset = 10
Width = oDrawingSheet.GetPaperWidth
height = oDrawingSheet.GetPaperHeight
XOrig = Width + xOffset
YOrig = yOffset
'Scan through the Product Structure of the assembly noteing the quantity of
'each component. Add one of each component to a list of the products for
'future use.
Dim n As Integer
Dim SourceText As String
Dim ProductList(50) As Product
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n
'Check to see if a BOM has already been created on the Drawing.
'This code will be utilized when updates to the BOM are needed.
'If the BOM table already exists, skip to the code which will
'populate the BOM.
For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then
GoTo POPULATEBOM
End If
Next n
'If the table does not exist, create one and label it the same as
'the table name being searched for.
Set oDrawingTable = oDrawingTables.Add(XOrig, YOrig, QtyDict.Count + 1, 5, 3, 5)
oDrawingTable.Name = "DrawingBOM"
oDrawingTable.AnchorPoint = CatTableBottomRight
'Populate the cells of the BOM Table
POPULATEBOM:
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 1, "Part Number"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 1, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 2, "Description"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 2, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 3, "Supplier"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 3, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 4, "Qty"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 4, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 5, "Source"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 5, 1, 1)
Call oDrawingTable.SetColumnSize(1, 50)
Call oDrawingTable.SetColumnSize(2, 110)
Call oDrawingTable.SetColumnSize(3, 110)
Call oDrawingTable.SetColumnSize(4, 12)
Call oDrawingTable.SetColumnSize(5, 20)
'Use the list created earlier in order to populate the information
'about each part in the product structure.
For n = 1 To (oDrawingTable.NumberOfRows - 1)
Call oDrawingTable.SetCellString(n, 1, ProductList(n).PartNumber)
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
Call oDrawingTable.SetCellString(n, 2, ProductList(n).Definition)
Call Dressup_Table(oDrawingTable, n, 2, 2, 0)
Call oDrawingTable.SetCellString(n, 3, ProductList(n).DescriptionRef)
Call Dressup_Table(oDrawingTable, n, 3, 2, 0)
Call oDrawingTable.SetCellString(n, 4, QtyDict.Item(ProductList(n).PartNumber))
Call Dressup_Table(oDrawingTable, n, 4, 1, 0)
Select Case ProductList(n).Source
Case "0"
SourceText = "Unknown"
Case "1"
SourceText = "Made"
Case "2"
SourceText = "Bought"
End Select
Call oDrawingTable.SetCellString(n, 5, SourceText)
Call Dressup_Table(oDrawingTable, n, 5, 2, 0)
Next n
End Sub
Sub Dressup_Table(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)
'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)
'
'------------------------------------
' set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Arial (TrueType)"
'
' font height
'
current_text.SetFontSize 1, oText, 2.5
'
' graphical attributes
'
current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0
'
End Sub
我目前在宏中的代码：
Option Explicit
Sub CATMain()
'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant
Dim Width As Integer
Dim height As Integer
Dim xOffset As Integer
Dim yOffset As Integer
Dim XOrig As Integer
Dim YOrig As Integer
'Check that the ActiveDocument is a CATDrawing.
'If not, inform the user and terminate execution.
Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "This utility must be executed from a within a CATDrawing."
Exit Sub
End If
'Populate the Variables
Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(4)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Err.Clear
'Check that the linked document is a product and not a part
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
If Err.Number <> 0 Then
MsgBox "The linked model is not a product!", vbExclamation
Exit Sub
End If
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")
'get the sheet dimensions so that we can place the bom in the right
'place relative to the drawing border
xOffset = -90
yOffset = 200
Width = oDrawingSheet.GetPaperWidth
height = oDrawingSheet.GetPaperHeight
XOrig = Width + xOffset
YOrig = yOffset
'Scan through the Product Structure of the assembly noteing the quantity of
'each component. Add one of each component to a list of the products for
'future use.
Dim n As Integer
Dim SourceText As String
Dim ProductList(50) As Product
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n
'If the table does not exist, create one and label it the same as
'the table name being searched for.
Set oDrawingTable = oDrawingTables.Add(XOrig, YOrig, QtyDict.Count + 1, 9, 3, 5)
oDrawingTable.Name = "DrawingBOM"
oDrawingTable.AnchorPoint = CatTableBottomRight
'Populate the cells of the BOM Table
POPULATEBOM:
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 1, "QTY")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 1, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 2, "PART-NUMBER")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 2, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 3, "DESCRIPTION")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 3, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 4, "VENDOR")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 4, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 5, "STOCK NUMBER")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 5, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 6, "MATERIAL")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 6, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 7, "COATING")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 7, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 8, "WEIGHT")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 8, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 9, "REMARK")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 9, 1, 1)
Call oDrawingTable.SetColumnSize(1, 10)
Call oDrawingTable.SetColumnSize(2, 100)
Call oDrawingTable.SetColumnSize(3, 100)
Call oDrawingTable.SetColumnSize(4, 50)
Call oDrawingTable.SetColumnSize(5, 50)
Call oDrawingTable.SetColumnSize(6, 80)
Call oDrawingTable.SetColumnSize(7, 80)
Call oDrawingTable.SetColumnSize(8, 50)
Call oDrawingTable.SetColumnSize(9, 80)
'Use the list created earlier in order to populate the information
'about each part in the product structure.
For n = 1 To (oDrawingTable.NumberOfRows - 1)
Call oDrawingTable.SetCellString(n, 1, QtyDict.Item(ProductList(n).PartNumber))
Call Dressup_Table(oDrawingTable, n, 1, 1, 0)
Call oDrawingTable.SetCellString(n, 2, ProductList(n).UserRefProperties.CE_NUMBER)
Call Dressup_Table(oDrawingTable, n, 2, 2, 0)
Call oDrawingTable.SetCellString(n, 3, ProductList(n).UserRefProperties.Item("DESCRIPTION"))
Call Dressup_Table(oDrawingTable, n, 3, 2, 0)
Call oDrawingTable.SetCellString(n, 4, ProductList(n).UserRefProperties.Item("VENDOR"))
Call Dressup_Table(oDrawingTable, n, 4, 2, 0)
Call oDrawingTable.SetCellString(n, 5, ProductList(n).UserRefProperties.Item("STOCK_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 5, 2, 0)
Call oDrawingTable.SetCellString(n, 6, ProductList(n).UserRefProperties.Item("MATERIAL"))
Call Dressup_Table(oDrawingTable, n, 6, 2, 0)
Call oDrawingTable.SetCellString(n, 7, ProductList(n).UserRefProperties.Item("COATING"))
Call Dressup_Table(oDrawingTable, n, 7, 2, 0)
Call oDrawingTable.SetCellString(n, 8, ProductList(n).UserRefProperties.Item("CC_CALC_WEIGHT"))
Call Dressup_Table(oDrawingTable, n, 8, 2, 0)
Call oDrawingTable.SetCellString(n, 9, ProductList(n).UserRefProperties.Item("REMARK"))
Call Dressup_Table(oDrawingTable, n, 9, 2, 0)
Next n
End Sub
Sub Dressup_Table(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)
'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)
'
'------------------------------------
' set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Arial (TrueType)"
'
' font height
'
current_text.SetFontSize 1, oText, 2.5
'
' graphical attributes
'
current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0
'
End Sub
目前我手头没有CATIA，但UserRefProperties的一项可能不是字符串，而是参数。在您的情况下，很可能是一个 StrParam，一个包含字符串的参数。尝试
ProductList(n).UserRefProperties.Item("CE_NUMBER").Value
而不是
ProductList(n).UserRefProperties.Item("CE_NUMBER")
除此之外，当您遍历所有产品时，请确保所有产品都具有该用户参数或处理无法保证的情况。
TLDR：
替换
ProductList(n).UserRefProperties.Item("CE_NUMBER")
和
ProductList(n).Product.UserRefProperties.Item("CE_NUMBER")
详细解释：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
此代码未执行的原因是方法 "UserRefProperties" 不适用于此特定对象级别的产品，即使方法 "Parameters" 在此级别有效。即使在检查产品文档时，您也会发现两组参数处于同一对象级别。
现在这可能会引起一些混乱，我会尽力澄清：
当 Catia 打开一个 .CATProduct 文件时，该文件被声明为一个 ProductDocument 对象，该对象包含可以在其上使用 Parameters 和 UserRefProperties 方法的 Product 对象。
当 ProductDocument 的子产品（= 在本例中为 oProductDoc）被调用时会出现混淆，在本例中是通过
Productlist(Index) = oProductDoc.Product.Products.item(n)
方法。
现在我们实际使用 ProductList(n) 调用的是原始 oProductDoc 的子产品的 ProductDocument。但是，我们实际上没有将 ProductList(n) 声明为 ProductDocument，而是将其声明为 Product。 Catia 认识到我们正在这样做并允许它发生，它还方便地 "uproots/copies" 所有 methods/properties/parameters 基础 Product 到这个对象。所有这些，除了 UserRefProperties。
因此，要真正了解 UserRefProperties，需要更深入一层，即 ProductList(n) 的 Product 层。最后我们找到了我原来问题的解决方案：
而不是使用
ProductList(n).UserRefProperties.Item("CE_NUMBER"))
我们应该将其替换为
ProductList(n).Product.UserRefProperties.Item("CE_NUMBER"))
我偶然发现了解决方案，反复试验。很长一段时间我都不知道为什么它会这样工作，但最近我在 VBA 中发现了 "Locals" window 并且很快我就明白了是怎么回事。
我并不是说我的解释是 100% 正确的，我的术语充其量只是粗略的，但我相信思路至少是在正确的方向上。
我放弃了尝试使用宏来制作自定义 BOM，因为 Catia 中的 Advanced BOM 选项足以满足我的需求。
我想创建自定义 BOM，我在 coe.org 论坛上找到了一个宏（请参阅 post 底部）。 我在按照我的要求实施它时遇到了一些困难。 在某些时候宏使用代码：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).PartNumber)
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
我测试了宏并且它有效，但是我想写一些用户定义的属性的值而不是预设的 CATIA 属性。 因此我将代码更改为：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
当我再次执行宏时，出现错误：
Automation error
Unspecified error
我是编程新手，但我用过
...Product.UserRefProperties.Item("CE_NUMBER")
在我的标题栏之前，它确实在那里工作。我尝试了多种变体，例如
ProductList(n).CE_NUMBER
但我无法让它工作。
我回溯了 Productlist(n)，它的声明如下：
Dim ProductList(50) As Product
据我所知，它应该 return 以 .Product 结尾的同一种东西，就像我标题栏中的代码一样。
任何人都知道如何让这个宏做我想做的事？ 提前致谢。
从coe.org复制的原始宏代码（缺少几个字符）：
Option Explicit
Sub CATMain()
On Error Resume Next
'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant
Dim Width As Integer
Dim height As Integer
Dim xOffset As Integer
Dim yOffset As Integer
Dim XOrig As Integer
Dim YOrig As Integer
'Check that the ActiveDocument is a CATDrawing.
'If not, inform the user and terminate execution.
Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) "CATDrawing" Then
MsgBox "This utility must be executed from a within a CATDrawing."
Exit Sub
End If
'Populate the Variables
Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View"
Set oDrawingTables = oBackgroundView.Tables
Err.Clear
'Check that the linked document is a product and not a part
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
If Err.Number 0 Then
MsgBox "The linked model is not a product!", vbExclamation
Exit Sub
End If
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary"
'get the sheet dimensions so that we can place the bom in the right
'place relative to the drawing border
xOffset = -90
yOffset = 10
Width = oDrawingSheet.GetPaperWidth
height = oDrawingSheet.GetPaperHeight
XOrig = Width + xOffset
YOrig = yOffset
'Scan through the Product Structure of the assembly noteing the quantity of
'each component. Add one of each component to a list of the products for
'future use.
Dim n As Integer
Dim SourceText As String
Dim ProductList(50) As Product
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n
'Check to see if a BOM has already been created on the Drawing.
'This code will be utilized when updates to the BOM are needed.
'If the BOM table already exists, skip to the code which will
'populate the BOM.
For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then
GoTo POPULATEBOM
End If
Next n
'If the table does not exist, create one and label it the same as
'the table name being searched for.
Set oDrawingTable = oDrawingTables.Add(XOrig, YOrig, QtyDict.Count + 1, 5, 3, 5)
oDrawingTable.Name = "DrawingBOM"
oDrawingTable.AnchorPoint = CatTableBottomRight
'Populate the cells of the BOM Table
POPULATEBOM:
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 1, "Part Number"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 1, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 2, "Description"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 2, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 3, "Supplier"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 3, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 4, "Qty"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 4, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 5, "Source"
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 5, 1, 1)
Call oDrawingTable.SetColumnSize(1, 50)
Call oDrawingTable.SetColumnSize(2, 110)
Call oDrawingTable.SetColumnSize(3, 110)
Call oDrawingTable.SetColumnSize(4, 12)
Call oDrawingTable.SetColumnSize(5, 20)
'Use the list created earlier in order to populate the information
'about each part in the product structure.
For n = 1 To (oDrawingTable.NumberOfRows - 1)
Call oDrawingTable.SetCellString(n, 1, ProductList(n).PartNumber)
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
Call oDrawingTable.SetCellString(n, 2, ProductList(n).Definition)
Call Dressup_Table(oDrawingTable, n, 2, 2, 0)
Call oDrawingTable.SetCellString(n, 3, ProductList(n).DescriptionRef)
Call Dressup_Table(oDrawingTable, n, 3, 2, 0)
Call oDrawingTable.SetCellString(n, 4, QtyDict.Item(ProductList(n).PartNumber))
Call Dressup_Table(oDrawingTable, n, 4, 1, 0)
Select Case ProductList(n).Source
Case "0"
SourceText = "Unknown"
Case "1"
SourceText = "Made"
Case "2"
SourceText = "Bought"
End Select
Call oDrawingTable.SetCellString(n, 5, SourceText)
Call Dressup_Table(oDrawingTable, n, 5, 2, 0)
Next n
End Sub
Sub Dressup_Table(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)
'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)
'
'------------------------------------
' set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Arial (TrueType)"
'
' font height
'
current_text.SetFontSize 1, oText, 2.5
'
' graphical attributes
'
current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0
'
End Sub
我目前在宏中的代码：
Option Explicit
Sub CATMain()
'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant
Dim Width As Integer
Dim height As Integer
Dim xOffset As Integer
Dim yOffset As Integer
Dim XOrig As Integer
Dim YOrig As Integer
'Check that the ActiveDocument is a CATDrawing.
'If not, inform the user and terminate execution.
Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "This utility must be executed from a within a CATDrawing."
Exit Sub
End If
'Populate the Variables
Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(4)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Err.Clear
'Check that the linked document is a product and not a part
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
If Err.Number <> 0 Then
MsgBox "The linked model is not a product!", vbExclamation
Exit Sub
End If
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")
'get the sheet dimensions so that we can place the bom in the right
'place relative to the drawing border
xOffset = -90
yOffset = 200
Width = oDrawingSheet.GetPaperWidth
height = oDrawingSheet.GetPaperHeight
XOrig = Width + xOffset
YOrig = yOffset
'Scan through the Product Structure of the assembly noteing the quantity of
'each component. Add one of each component to a list of the products for
'future use.
Dim n As Integer
Dim SourceText As String
Dim ProductList(50) As Product
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n
'If the table does not exist, create one and label it the same as
'the table name being searched for.
Set oDrawingTable = oDrawingTables.Add(XOrig, YOrig, QtyDict.Count + 1, 9, 3, 5)
oDrawingTable.Name = "DrawingBOM"
oDrawingTable.AnchorPoint = CatTableBottomRight
'Populate the cells of the BOM Table
POPULATEBOM:
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 1, "QTY")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 1, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 2, "PART-NUMBER")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 2, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 3, "DESCRIPTION")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 3, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 4, "VENDOR")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 4, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 5, "STOCK NUMBER")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 5, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 6, "MATERIAL")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 6, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 7, "COATING")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 7, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 8, "WEIGHT")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 8, 1, 1)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 9, "REMARK")
Call Dressup_Table(oDrawingTable, oDrawingTable.NumberOfRows, 9, 1, 1)
Call oDrawingTable.SetColumnSize(1, 10)
Call oDrawingTable.SetColumnSize(2, 100)
Call oDrawingTable.SetColumnSize(3, 100)
Call oDrawingTable.SetColumnSize(4, 50)
Call oDrawingTable.SetColumnSize(5, 50)
Call oDrawingTable.SetColumnSize(6, 80)
Call oDrawingTable.SetColumnSize(7, 80)
Call oDrawingTable.SetColumnSize(8, 50)
Call oDrawingTable.SetColumnSize(9, 80)
'Use the list created earlier in order to populate the information
'about each part in the product structure.
For n = 1 To (oDrawingTable.NumberOfRows - 1)
Call oDrawingTable.SetCellString(n, 1, QtyDict.Item(ProductList(n).PartNumber))
Call Dressup_Table(oDrawingTable, n, 1, 1, 0)
Call oDrawingTable.SetCellString(n, 2, ProductList(n).UserRefProperties.CE_NUMBER)
Call Dressup_Table(oDrawingTable, n, 2, 2, 0)
Call oDrawingTable.SetCellString(n, 3, ProductList(n).UserRefProperties.Item("DESCRIPTION"))
Call Dressup_Table(oDrawingTable, n, 3, 2, 0)
Call oDrawingTable.SetCellString(n, 4, ProductList(n).UserRefProperties.Item("VENDOR"))
Call Dressup_Table(oDrawingTable, n, 4, 2, 0)
Call oDrawingTable.SetCellString(n, 5, ProductList(n).UserRefProperties.Item("STOCK_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 5, 2, 0)
Call oDrawingTable.SetCellString(n, 6, ProductList(n).UserRefProperties.Item("MATERIAL"))
Call Dressup_Table(oDrawingTable, n, 6, 2, 0)
Call oDrawingTable.SetCellString(n, 7, ProductList(n).UserRefProperties.Item("COATING"))
Call Dressup_Table(oDrawingTable, n, 7, 2, 0)
Call oDrawingTable.SetCellString(n, 8, ProductList(n).UserRefProperties.Item("CC_CALC_WEIGHT"))
Call Dressup_Table(oDrawingTable, n, 8, 2, 0)
Call oDrawingTable.SetCellString(n, 9, ProductList(n).UserRefProperties.Item("REMARK"))
Call Dressup_Table(oDrawingTable, n, 9, 2, 0)
Next n
End Sub
Sub Dressup_Table(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)
'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)
'
'------------------------------------
' set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Arial (TrueType)"
'
' font height
'
current_text.SetFontSize 1, oText, 2.5
'
' graphical attributes
'
current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0
'
End Sub
目前我手头没有CATIA，但UserRefProperties的一项可能不是字符串，而是参数。在您的情况下，很可能是一个 StrParam，一个包含字符串的参数。尝试
ProductList(n).UserRefProperties.Item("CE_NUMBER").Value
而不是
ProductList(n).UserRefProperties.Item("CE_NUMBER")
除此之外，当您遍历所有产品时，请确保所有产品都具有该用户参数或处理无法保证的情况。
TLDR：
替换
ProductList(n).UserRefProperties.Item("CE_NUMBER")
和
ProductList(n).Product.UserRefProperties.Item("CE_NUMBER")
详细解释：
Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
此代码未执行的原因是方法 "UserRefProperties" 不适用于此特定对象级别的产品，即使方法 "Parameters" 在此级别有效。即使在检查产品文档时，您也会发现两组参数处于同一对象级别。
现在这可能会引起一些混乱，我会尽力澄清： 当 Catia 打开一个 .CATProduct 文件时，该文件被声明为一个 ProductDocument 对象，该对象包含可以在其上使用 Parameters 和 UserRefProperties 方法的 Product 对象。 当 ProductDocument 的子产品（= 在本例中为 oProductDoc）被调用时会出现混淆，在本例中是通过
Productlist(Index) = oProductDoc.Product.Products.item(n)
方法。
现在我们实际使用 ProductList(n) 调用的是原始 oProductDoc 的子产品的 ProductDocument。但是，我们实际上没有将 ProductList(n) 声明为 ProductDocument，而是将其声明为 Product。 Catia 认识到我们正在这样做并允许它发生，它还方便地 "uproots/copies" 所有 methods/properties/parameters 基础 Product 到这个对象。所有这些，除了 UserRefProperties。
因此，要真正了解 UserRefProperties，需要更深入一层，即 ProductList(n) 的 Product 层。最后我们找到了我原来问题的解决方案：
而不是使用
ProductList(n).UserRefProperties.Item("CE_NUMBER"))
我们应该将其替换为
ProductList(n).Product.UserRefProperties.Item("CE_NUMBER"))
我偶然发现了解决方案，反复试验。很长一段时间我都不知道为什么它会这样工作，但最近我在 VBA 中发现了 "Locals" window 并且很快我就明白了是怎么回事。
我并不是说我的解释是 100% 正确的，我的术语充其量只是粗略的，但我相信思路至少是在正确的方向上。
我放弃了尝试使用宏来制作自定义 BOM，因为 Catia 中的 Advanced BOM 选项足以满足我的需求。