Catia V5 Macro - Set Instance Name Equal to Part Number

Catia V5 Macro - Set Instance Name Equal to Part Number

Please read Liability Disclaimer and License Agreement CAREFULLY

Tree structure before running the macro:

Tree structure after running the macro:

Create a class module called MyItem and add the following code in it

Public PartNumber As String
Public InstanceName As String
Public FileName As String
Public Count As Integer

Create a new Module and paste the code below in it

Option Explicit
Dim MyItems As New Collection
Dim Prod As ProductDocument
Dim CrtProd As Product
Dim rec As MyItem
Sub CATMain()
    Dim Warning As Integer
    Warning = MsgBox("Notice!!!" & VBA.Chr(13) & "Copyright © 2004 Grozea Ion" & VBA.Chr(13) & "Do you wish to continue?", vbYesNo, "Product2Part")
    If Warning = 6 Then
        If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then
            MsgBox "CATIA active document is not valid!" & VBA.Chr(13) & "This macro runs only on CATProduct.", vbExclamation, "Product2Part!!!"
            Exit Sub
        Else
            Set Prod = CATIA.ActiveDocument
            ProcessAssy
        End If
    Else
        Exit Sub
    End If
    For Each rec In MyItems
        MyItems.Remove 1
    Next
End Sub
Sub ProcessAssy()
    For Each CrtProd In Prod.Product.Products
        Dim Pos As Integer
        Dim NewItem As New MyItem
        Pos = IsIn(CrtProd.PartNumber)
        'Debug.Print "PN: " & CrtProd.PartNumber & " IN: " & CrtProd.Name
        If Pos > -1 Then
            Set NewItem = MyItems.item(Pos)
            NewItem.Count = NewItem.Count + 1
            MyItems.Remove (Pos)
            
        Else
            NewItem.PartNumber = CrtProd.PartNumber
            NewItem.InstanceName = CrtProd.Name
            'NewItem.FileName = CrtProd.GetMasterShapeRepresentationPathName
            NewItem.Count = 1
        End If
        CrtProd.Name = CrtProd.PartNumber & "." & NewItem.Count
        CrtProd.Update
        MyItems.Add NewItem, NewItem.PartNumber
        Set NewItem = Nothing
        Pos = 0
    Next
End Sub
Function IsIn(item As String) As Integer
    For Each rec In MyItems
    IsIn = IsIn + 1
        If (rec.PartNumber = item) Then
            Exit Function
        End If
    Next
    IsIn = -1
End Function