×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Catia macro to replace Property with UserRefProperties in the complete tree

Catia macro to replace Property with UserRefProperties in the complete tree

Catia macro to replace Property with UserRefProperties in the complete tree

(OP)
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 :

CODE --> VBA

'********************************************************
'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
Dim j As Integer
Dim k As Integer

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


'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts

For i = 1 To NumberOfItems                             'Cycle through the assembly's children
    Set ItemToRename = oCurrentProd.Products.Item(i)    'Declare which item we are working on
    
    ToRenamePartNumber = ItemToRename.PartNumber            'Get the Part Number
        
    If InStr(ToRenamePartNumber, "-_") <> 0 Then         'Check for KT #'s, should exist only in CGRs
        ToRenamePartNumber = Left(ToRenamePartNumber, (InStr(ToRenamePartNumber, "-_") - 1))
    End If
    
    RenameArray(i) = ToRenamePartNumber                 'Building the list of part names for the numbering loop
    
    
    k = 0                                               'Numbering Loop
    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    'Set the new instance name, to a TEMP dummy value

Next

'Run through this loop to set the name finally, then the recursion call

For i = 1 To NumberOfItems
    Set ItemToRename = oCurrentProd.Products.Item(i)
           
    ToRenamePartNumber = ItemToRename.PartNumber        'Toggle these two lines for testing
           
    RenameArray(i) = ToRenamePartNumber
    
    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

    
    'ItemToRename.DescriptionInst = "CC1"
    'ItemToRename.Nomenclature = "BB1"
    'oCurrentProd.DescriptionRef = "CC2"
    'oCurrentProd.Nomenclature = "BB2"    
    
    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    'Set the new instance name final
     
    If ItemToRename.Products.Count <> 0 Then        'Recursive Call
        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.

RE: Catia macro to replace Property with UserRefProperties in the complete tree

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

RE: Catia macro to replace Property with UserRefProperties in the complete tree

(OP)
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.

CODE --> VBA

'********************************************************
'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
Dim j As Integer
Dim k As Integer

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

objectNumberOfItems = oCurrentProd.Products.Count


'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts

For i = 1 To NumberOfItems                             'Cycle through the assembly's children
    Set ItemToRename = oCurrentProd.Products.Item(i)    'Declare which item we are working on
    
    ToRenamePartNumber = ItemToRename.PartNumber            'Get the Part Number
        
    If InStr(ToRenamePartNumber, "-_") <> 0 Then         'Check for KT #'s, should exist only in CGRs
        ToRenamePartNumber = Left(ToRenamePartNumber, (InStr(ToRenamePartNumber, "-_") - 1))
    End If
    
    RenameArray(i) = ToRenamePartNumber                 'Building the list of part names for the numbering loop
    
    
    k = 0                                               'Numbering Loop
    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    'Set the new instance name, to a TEMP dummy value

Next

'Run through this loop to set the name finally, then the recursion call

For i = 1 To NumberOfItems
    Set ItemToRename = oCurrentProd.Products.Item(i)
           
    ToRenamePartNumber = ItemToRename.PartNumber        'Toggle these two lines for testing
           
    RenameArray(i) = ToRenamePartNumber
    
    '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

    ItemToRename.DescriptionRef = ItemToRename.UserRefProperties.GetItem("Designation").Value
    ItemToRename.Nomenclature = ItemToRename.UserRefProperties.GetItem("codeGPAO").Value
    
    oCurrentProd.DescriptionRef = oCurrentProd.UserRefProperties.GetItem("Designation").Value
    oCurrentProd.Nomenclature = oCurrentProd.UserRefProperties.GetItem("codeGPAO").Value

            
    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    'Set the new instance name final
     
    If ItemToRename.Products.Count <> 0 Then        'Recursive Call
        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 ??

CODE --> VBA

Set ItemToRename = oCurrentProd.Products.Item(i) 


Thank you.

RE: Catia macro to replace Property with UserRefProperties in the complete tree

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 sunshine

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:

CODE --> VBA

'********************************************************
'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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources