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 :
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.
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
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
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
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
Thank you.
RE: Catia macro to replace Property with UserRefProperties in the complete tree
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:
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 SubCheers,
Mark