Catia macro to replace Property with UserRefProperties in the complete tree 1

[eperichon]

Hello,

I am new in VBA and try to modify a code that change the instance name, in order that this code also change every catia properties of each parts, products ... in the complete tree. In fact I want that this instance rename code also change component DescriptionRef and Nomenclature with UserRefProperties that exists in each components.

I have the following code found on internet :

[COLOR=#4E9A06]'********************************************************
'By MarkAF, some code borrowed from forums
'********************************************************[/color]

Public oList As Variant
Option Explicit

Sub CATMain()
On Error Resume Next

[COLOR=#4E9A06]'Declarations[/color]

Dim oTopDoc As Document
Dim oTopProd As ProductDocument
Dim oCurrentProd As Product
Dim n As Integer

[COLOR=#4E9A06]'Check if the active document is an assembly, else exit[/color]

Set oTopDoc = CATIA.ActiveDocument

If oTopDoc Is Nothing Then
        MsgBox "Must have an assembly open"
        Exit Sub
End If
    
    
If Right(oTopDoc.Name, 7) <> "Product" Then
    MsgBox "Active document should be a product"
    Exit Sub
End If

Set oCurrentProd = oTopDoc.Product

Set oList = CreateObject("Scripting.dictionary")


CATIA.StatusBar = "Working On" & " " & oCurrentProd.Name


Call RenameSingleLevel(oCurrentProd)    [COLOR=#4E9A06]'Call the subroutine, it is a recursive loop[/color]

CATIA.StatusBar = "Done"

End Sub

Private Sub RenameSingleLevel(ByRef oCurrentProd As Product)

On Error Resume Next

[COLOR=#4E9A06]'More declarations[/color]

Dim ItemToRename As Product
Dim ToRenamePartNumber As String
Dim ToRenamePartDescription As String
Dim NumberOfItems As Long
Dim RenameArray(2000) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set oCurrentProd = oCurrentProd.ReferenceProduct    [COLOR=#4E9A06]'You have to work with the "ReferenceProduct" object[/color]NumberOfItems = oCurrentProd.Products.Count


[COLOR=#4E9A06]'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts[/color]

For i = 1 To NumberOfItems                             [COLOR=#4E9A06]'Cycle through the assembly's children[/color]
    Set ItemToRename = oCurrentProd.Products.Item(i)    [COLOR=#4E9A06]'Declare which item we are working on[/color]
    
    ToRenamePartNumber = ItemToRename.PartNumber           [COLOR=#4E9A06] 'Get the Part Number[/color]
        
    If InStr(ToRenamePartNumber, "-_") <> 0 Then         [COLOR=#4E9A06]'Check for KT #'s, should exist only in CGRs[/color]
        ToRenamePartNumber = Left(ToRenamePartNumber, (InStr(ToRenamePartNumber, "-_") - 1))
    End If
    
    RenameArray(i) = ToRenamePartNumber                 [COLOR=#4E9A06]'Building the list of part names for the numbering loop[/color]
    
    
    k = 0                                               [COLOR=#4E9A06]'Numbering Loop[/color]
    For j = 1 To i                                      [COLOR=#4E9A06]'This loop checks and sets the instance number[/color]
        If RenameArray(j) = ToRenamePartNumber Then
            k = k + 1
        End If
    Next
    CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
    ItemToRename.Name = ToRenamePartNumber & "TEMP." & k    [COLOR=#4E9A06]'Set the new instance name, to a TEMP dummy value[/color]

Next

[COLOR=#4E9A06]'Run through this loop to set the name finally, then the recursion call[/color]

For i = 1 To NumberOfItems
    Set ItemToRename = oCurrentProd.Products.Item(i)
           
    ToRenamePartNumber = ItemToRename.PartNumber        [COLOR=#4E9A06]'Toggle these two lines for testing[/color]
           
    RenameArray(i) = ToRenamePartNumber
    
    [COLOR=#EF2929]ItemToRename.DescriptionInst = ItemToRename.UserRefProperties.Item("Designation").Value
    ItemToRename.Nomenclature = ItemToRename.UserRefProperties.Item("codeGPAO").Value
    oCurrentProd.DescriptionRef = oCurrentProd.UserRefProperties.Item("Designation").Value
    oCurrentProd.Nomenclature = oCurrentProd.UserRefProperties.Item("codeGPAO").Value[/color]

    
    [COLOR=#4E9A06]'ItemToRename.DescriptionInst = "CC1"
    'ItemToRename.Nomenclature = "BB1"
    'oCurrentProd.DescriptionRef = "CC2"
    'oCurrentProd.Nomenclature = "BB2"[/color]    
    
    k = 0
    For j = 1 To i
        If RenameArray(j) = ToRenamePartNumber Then
            k = k + 1
        End If
    Next
    
    CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
        
    ItemToRename.Name = ToRenamePartNumber & "." & k    [COLOR=#4E9A06]'Set the new instance name final[/color]
     
    If ItemToRename.Products.Count <> 0 Then        [COLOR=#4E9A06]'Recursive Call[/color]
        If oList.exists(ItemToRename.PartNumber) Then GoTo Finish

        If ItemToRename.PartNumber = ItemToRename.ReferenceProduct.Parent.Product.PartNumber Then oList.Add ItemToRename.PartNumber, 1
        Call RenameSingleLevel(ItemToRename)
    End If

Finish:
Next


End Sub

In fact the code works, but only for the products inside the complete tree (red line were added). It doesn't work for the parts inside this one... WHY ??? But if I only put some text between "...", it works for every components inside the tree. i don't understand, I need some help please. Thank you.

 

[MarkAF]

I think you have to use the "GetItem" method in order to call the UserRefProperties by name. Using the "Item()" method it wants an index number, such as .Item(1) or .Item(i) where 'i' is an integer.

So, each line of code would look like this:
ItemToRename.DescriptionInst = ItemToRename.UserRefProperties.GetItem("Designation").Value

This is coming from the Dassault VBA help file. Hope that helps.

Mark

 

[eperichon]

Hello Mark,

Thank you for your answer. I have just tried to modify the code, but I have still the same issue. It works on all the products of the tree, but it doesn't work for the parts inside the tree.

[COLOR=#4E9A06]'********************************************************
'By MarkAF, some code borrowed from forums
'********************************************************[/color]
Public oList As Variant
Option Explicit

Sub CATMain()
On Error Resume Next

[COLOR=#4E9A06]'Declarations[/color]

Dim oTopDoc As Document
Dim oTopProd As ProductDocument
Dim oCurrentProd As Product
Dim n As Integer

[COLOR=#4E9A06]'Check if the active document is an assembly, else exit[/color]

Set oTopDoc = CATIA.ActiveDocument

If oTopDoc Is Nothing Then
        MsgBox "Must have an assembly open"
        Exit Sub
End If
    
    
If Right(oTopDoc.Name, 7) <> "Product" Then
    MsgBox "Active document should be a product"
    Exit Sub
End If

Set oCurrentProd = oTopDoc.Product

Set oList = CreateObject("Scripting.dictionary")


CATIA.StatusBar = "Working On" & " " & oCurrentProd.Name


Call RenameSingleLevel(oCurrentProd)    [COLOR=#4E9A06]'Call the subroutine, it is a recursive loop[/color]

CATIA.StatusBar = "Done"

End Sub

Private Sub RenameSingleLevel(ByRef oCurrentProd As Product)

On Error Resume Next

[COLOR=#4E9A06]'More declarations[/color]

Dim ItemToRename As Product
Dim ToRenamePartNumber As String
Dim ToRenamePartDescription As String
Dim NumberOfItems As Long
Dim RenameArray(2000) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set oCurrentProd = oCurrentProd.ReferenceProduct    [COLOR=#4E9A06]'You have to work with the "ReferenceProduct"[/color] 

objectNumberOfItems = oCurrentProd.Products.Count


[COLOR=#4E9A06]'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts[/color]

For i = 1 To NumberOfItems                             [COLOR=#4E9A06]'Cycle through the assembly's children[/color]
    Set ItemToRename = oCurrentProd.Products.Item(i)    [COLOR=#4E9A06]'Declare which item we are working on[/color]
    
    ToRenamePartNumber = ItemToRename.PartNumber            [COLOR=#4E9A06]'Get the Part Number[/color]
        
    If InStr(ToRenamePartNumber, "-_") <> 0 Then         [COLOR=#4E9A06]'Check for KT #'s, should exist only in CGRs[/color]
        ToRenamePartNumber = Left(ToRenamePartNumber, (InStr(ToRenamePartNumber, "-_") - 1))
    End If
    
    RenameArray(i) = ToRenamePartNumber                 [COLOR=#4E9A06]'Building the list of part names for the numbering loop[/color]
    
    
    k = 0                                               [COLOR=#4E9A06]'Numbering Loop[/color]
    For j = 1 To i                                      'This loop checks and sets the instance number
        If RenameArray(j) = ToRenamePartNumber Then
            k = k + 1
        End If
    Next
    CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
    ItemToRename.Name = ToRenamePartNumber & "TEMP." & k    [COLOR=#4E9A06]'Set the new instance name, to a TEMP dummy value[/color]

Next

[COLOR=#4E9A06]'Run through this loop to set the name finally, then the recursion call[/color]

For i = 1 To NumberOfItems
    Set ItemToRename = oCurrentProd.Products.Item(i)
           
    ToRenamePartNumber = ItemToRename.PartNumber        [COLOR=#4E9A06]'Toggle these two lines for testing[/color]
           
    RenameArray(i) = ToRenamePartNumber
    
    [COLOR=#4E9A06]'ItemToRename.DescriptionInst = ItemToRename.UserRefProperties.Item("Designation").Value
    'ItemToRename.Nomenclature = ItemToRename.UserRefProperties.Item("codeGPAO").Value
    'oCurrentProd.DescriptionRef = oCurrentProd.UserRefProperties.Item("Designation").Value
    'oCurrentProd.Nomenclature = oCurrentProd.UserRefProperties.Item("codeGPAO").Value[/color]

    [COLOR=#EF2929]ItemToRename.DescriptionRef = ItemToRename.UserRefProperties.GetItem("Designation").Value
    ItemToRename.Nomenclature = ItemToRename.UserRefProperties.GetItem("codeGPAO").Value[/color]
    
    [COLOR=#729FCF]oCurrentProd.DescriptionRef = oCurrentProd.UserRefProperties.GetItem("Designation").Value
    oCurrentProd.Nomenclature = oCurrentProd.UserRefProperties.GetItem("codeGPAO").Value[/color]

            
    k = 0
    For j = 1 To i
        If RenameArray(j) = ToRenamePartNumber Then
            k = k + 1
        End If
    Next
    
    CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
        
    ItemToRename.Name = ToRenamePartNumber & "." & k    [COLOR=#4E9A06]'Set the new instance name final[/color]
     
    If ItemToRename.Products.Count <> 0 Then        [COLOR=#4E9A06]'Recursive Call[/color]
        If oList.exists(ItemToRename.PartNumber) Then GoTo Finish

        If ItemToRename.PartNumber = ItemToRename.ReferenceProduct.Parent.Product.PartNumber Then oList.Add ItemToRename.PartNumber, 1
        Call RenameSingleLevel(ItemToRename)
    End If

Finish:
Next


End Sub

For the blue lines, it works well for every products and sub-products. But I think that the red lines don't work because no parts properties were change...

Is it because ItemToRename is define as Products ??

Set ItemToRename = oCurrentProd.Products.Item(i)

Thank you.

 

[MarkAF]

Ok, I finally had a bit of time to look at this. Sorry it's taken a while.
So, there's a few things going on. I found that for this, instead of accessing the DescriptionRef property directly from the Product object, you have to access it through the ReferenceProduct object. I don't know why...perhaps someone else can enlighten us

Your line of code to transfer the properties should then look like this:
ItemToRename.DescriptionRef = ItemToRename.ReferenceProduct.UserRefProperties.GetItem("Designation").Value
ItemToRename.Nomenclature = ItemToRename.ReferenceProduct.UserRefProperties.GetItem("codeGPAO").Value

Also, for your purposes, there's a big chunk of code that you do not need. The whole section that starts with the comment "Run through this loop once" can be deleted, it's only to deal with instance names. The section with the k counter can be deleted, since it's also for the instance name.

Last point, this code is not optimized for larger assemblies. If it comes across a part or assembly again, it will work on that part or assembly again. In some macros I have worked to avoid this, but I don't have it at my fingertips right now.

The most fascinating thing to me is the recursive call. It kind of boggled my mind for a while. Recursions are well worth studying...call stacks and all that. I'm sure that what I came up with is about as simple as it gets, but it works for this purpose.

Here's what it looks like once I got it cleaned up a bit:

'********************************************************
'By MarkAF, some code borrowed from forums
'********************************************************
Public oList As Variant
Option Explicit

Sub CATMain()
On Error Resume Next

'Declarations

Dim oTopDoc As Document
Dim oTopProd As ProductDocument
Dim oCurrentProd As Product
Dim n As Integer

'Check if the active document is an assembly, else exit

Set oTopDoc = CATIA.ActiveDocument

If oTopDoc Is Nothing Then
        MsgBox "Must have an assembly open"
        Exit Sub
End If
    
    
If Right(oTopDoc.Name, 7) <> "Product" Then
    MsgBox "Active document should be a product"
    Exit Sub
End If

Set oCurrentProd = oTopDoc.Product

Set oList = CreateObject("Scripting.dictionary")


CATIA.StatusBar = "Working On" & " " & oCurrentProd.Name


Call RenameSingleLevel(oCurrentProd)    'Call the subroutine, it is a recursive loop

CATIA.StatusBar = "Done"

End Sub

Private Sub RenameSingleLevel(ByRef oCurrentProd As Product)

On Error Resume Next

'More declarations

Dim ItemToRename As Product
Dim ToRenamePartNumber As String
Dim ToRenamePartDescription As String
Dim NumberOfItems As Long
Dim RenameArray(2000) As String
Dim i As Integer

Set oCurrentProd = oCurrentProd.ReferenceProduct    'You have to work with the "ReferenceProduct"

NumberOfItems = oCurrentProd.Products.Count

For i = 1 To NumberOfItems
    Set ItemToRename = oCurrentProd.Products.Item(i)
           
    ToRenamePartNumber = ItemToRename.PartNumber        'Toggle these two lines for testing
           
    RenameArray(i) = ToRenamePartNumber
    
    CATIA.StatusBar = "Working on " & ItemToRename.Name
 
    ItemToRename.DescriptionRef = ItemToRename.ReferenceProduct.UserRefProperties.GetItem("Designation").Value
    ItemToRename.Nomenclature = ItemToRename.ReferenceProduct.UserRefProperties.GetItem("codeGPAO").Value
    
'This section is the recursive call. If this level has children products, then it will step down to that level.
    If ItemToRename.Products.Count <> 0 Then
        If oList.exists(ItemToRename.PartNumber) Then GoTo Finish

        If ItemToRename.PartNumber = ItemToRename.ReferenceProduct.Parent.Product.PartNumber Then oList.Add ItemToRename.PartNumber, 1
        Call RenameSingleLevel(ItemToRename)
    End If

Finish:
Next


End Sub

Cheers,
Mark