MACRO CATIA Problem
MACRO CATIA Problem
(OP)
Hello,
I am pretty new to programming CATIA Macros and I need some help. Macro, I am stuck on, is suppose to change all the instance names in the specifiaction tree to match the part names of the products/parts etc. It works well on the first level, but when I am trying to change products deeper in the tree, macro seems not to work. To be specific I can not change instance name of the product - no error is displayed - it just does not work. Any help is appreciated.
Here is the code:
I am pretty new to programming CATIA Macros and I need some help. Macro, I am stuck on, is suppose to change all the instance names in the specifiaction tree to match the part names of the products/parts etc. It works well on the first level, but when I am trying to change products deeper in the tree, macro seems not to work. To be specific I can not change instance name of the product - no error is displayed - it just does not work. Any help is appreciated.
Here is the code:
CODE
Sub CATMain()
Dim topProduct As Product
Set topProduct = CATIA.ActiveDocument.Product
'Switch to design mode
topProduct.ApplyWorkMode DESIGN_MODE
'Uncommented will work for first level of the specification tree
'renamePartInstance topProduct
GetNextNode topProduct
End Sub
Sub GetNextNode(oCurrentProduct As Product)
'MsgBox (oCurrentProduct.Name & "Product count: " & oCurrentProduct.Products.Count)
If oCurrentProduct.Products.Count = 0 Then
Exit Sub
End If
Dim oCurrentTreeNode As Product
Dim i As Integer
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
' Determine if the current node is a product
If IsProduct(oCurrentTreeNode) = True Then
' custom function that renames instance name so it's matching products part name
' MsgBox oCurrentTreeNode.Name & " is a product"
GetNextNode oCurrentTreeNode
renamePartInstance oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
Sub renamePartInstance(oTopProduct As Product)
Dim ItemToRename As Product
Dim ItemToRenamePartNumber, tmp As String
Dim oDict1 'Dictionary Object
Dim lNumberOfItems As Long
Dim i As Integer
'Switch to design mode
oTopProduct.ApplyWorkMode DESIGN_MODE
Set oDict1 = CreateObject("Scripting.Dictionary")
lNumberOfItems = oTopProduct.Products.Count
'Renaming all the instance names to avoid coflicts later
For i = 1 To lNumberOfItems
Set ItemToRename = oTopProduct.Products.Item(i)
'THIS ASSIGNMENT DOES NOT WORK - NO ERROR DISPLAYED
ItemToRename.Name = "0" & "." & i
'MsgBox ("Product: " & oTopProduct.Name & " Item to renamepartnumber: " & ItemToRename.Name)
Next 'i
'Properly renaming all of the instace names
For i = 1 To lNumberOfItems
Set ItemToRename = oTopProduct.Products.Item(i)
ItemToRenamePartNumber = ItemToRename.PartNumber
'See if the item is already in list, in that case increment the suffix number by 1 before renaming
If oDict1.Exists(ItemToRenamePartNumber) Then
oDict1.Item(ItemToRenamePartNumber) = oDict1.Item(ItemToRenamePartNumber) + 1
Else: oDict1.Add (ItemToRenamePartNumber), "1"
End If
'Rename the items instance name like this: Part Number + "." + suffix number
ItemToRename.Name = (ItemToRenamePartNumber & "." & oDict1.Item(ItemToRenamePartNumber))
'THIS ASSIGNMENT ALSO DOES NOT WORK
'MsgBox ("Product: " & oTopProduct.Name & "Item to rename: " & ItemToRename.Name)
Next 'i
Set oDict1 = Nothing
End Sub 




RE: MACRO CATIA Problem
Did you searched the forum?
Regards
Fernando
https://picasaweb.google.com/102257836106335725208
https://picasaweb.google.com/103462806772634246699...
RE: MACRO CATIA Problem
You'll need to use a recursive function (a function that calls itself). Take a look at my code on thread 365400. Link below:
http://www.eng-tips.com/viewthread.cfm?qid=365400
Regards,
Drew Mumaw
http://www.drewmumaw.com/
http://www.textsketcher.com/