Search code examples
vbacatia

CATIA v5 VBA: Custom BOM Macro inserting UserRefProperties into table


I want to create a custom BOM and I found a macro on the coe.org forum (see at bottom of post). I'm having some difficulties implementing it as I require. At some point the macro uses the code:

Call oDrawingTable.SetCellString(n, 1, ProductList(n).PartNumber)
    Call Dressup_Table(oDrawingTable, n, 1, 2, 0)

I tested the macro and this works, however I want to write the value of some User defined Properties instead of the preset CATIA properties. Therefore I change the code to:

Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
    Call Dressup_Table(oDrawingTable, n, 1, 2, 0)

When I execute the macro again I get the errors:

Automation error

Unspecified error

I'm new to programming in general but I've used

...Product.UserRefProperties.Item("CE_NUMBER") 

before in my title block and it does work there. I've tried multiple variations like

ProductList(n).CE_NUMBER

But I can't get it to work.

I've backtracked Productlist(n) and it's declared like this:

Dim ProductList(50) As Product

As far as I can see it should return the same kind of thing that ends in .Product just like the code in my title block does.

Anyone knows how to get this macro to do what I want it to do? Thx in advance.

Original macro code copied from coe.org (it has a couple of missing characters):

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

Code I currently have in my macro:

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

Solution

  • TLDR:
    Replace

    ProductList(n).UserRefProperties.Item("CE_NUMBER")
    

    with

    ProductList(n).Product.UserRefProperties.Item("CE_NUMBER")
    

    Long explanation:

    Call oDrawingTable.SetCellString(n, 1, ProductList(n).UserRefProperties.Item("CE_NUMBER"))
        Call Dressup_Table(oDrawingTable, n, 1, 2, 0)
    

    The reason this code does not execute is because the method "UserRefProperties" does not work for a product at this particular object level, even though the method "Parameters" DOES work at this level. EVEN THOUGH WHEN INSPECTING A PRODUCTDOCUMENT YOU WILL FIND BOTH SETS OF PARAMETERS AT THE SAME OBJECT LEVEL.

    Now this can cause some confusion and I'll try to clarify: When Catia opens a .CATProduct file this file is declared a ProductDocument object, this object contains the Product object on which one can use the Parameters and UserRefProperties methods. The confusion arises when a child Product of a ProductDocument (= in this case oProductDoc) is called, in this case through the

    Productlist(Index) =  oProductDoc.Product.Products.item(n)
    

    method.

    Now what we are actually calling with ProductList(n) a bit further down the original BOM code posted above is the ProductDocument of a child product of the original oProductDoc. But instead of declaring ProductList(n) as a ProductDocument, we actually declare it a Product. Catia recognizes we are doing this and allows it to happen, it also conveniently "uproots/copies" all methods/properties/parameters of the underlying Product to this object. ALL OF THEM EXCEPT UserRefProperties.
    So, to actually get to the UserRefProperties one needs to go one level deeper, the Product level of ProductList(n). Finally we arrive at the solution to my original problem:

    Instead of using

    ProductList(n).UserRefProperties.Item("CE_NUMBER"))
    

    we should replace that with

    ProductList(n).Product.UserRefProperties.Item("CE_NUMBER"))
    

    I discovered the solution by accident, trial & error. For a long time I had no idea why it worked the way it did but recently I discovered the "Locals" window in VBA and it soon became clear to me what was going on.
    I'm not saying my explanation is 100% correct and my terminology is sketchy at best, but I believe the train of thought is at least in the right direction.

    I gave up trying to make a customized BOM with a macro because the Advanced BOM option in Catia can accomplish enough to satisfy my needs.