This VBA-macro  corrects mismatching instance names for all products loaded into Catia.

If you have ever used 'Component Replace' to swap fasteners, you know the problem.

The instance name no longer matches the part number.

The macro adjusts the instance name to match the part number.

The code:


'---------------------------------------------------------------------------------------
' Module    : modInstanceEqualName
' Author    : jherzog
' Date      : 19.03.2016
' Purpose   : Rename product instances of all products in all windows to match part name,
'           : while sorting the instances within a product
'---------------------------------------------------------------------------------------
Option Explicit

Sub CatMain()
   Dim oRootProds As Products
   Dim oADP As Product
   Dim n As Integer

   If CATIA.Windows.Count = 0 Then Exit Sub                'exit if no doc opened    CATIA.Interactive = False                               'no interaction allowed
   CATIA.Windows.Arrange catArrangeTiledVertical           'rearrange windows

   For n = 1 To CATIA.Windows.Count                        '
'      Debug.Print n, TypeName(CATIA.Windows.Item(n).Parent), CATIA.Windows.Item(n).Parent.Name

      If TypeName(CATIA.Windows.Item(n).Parent) = "ProductDocument" Then

         CATIA.Windows.Item(n).Activate                    'if product activate
         Set oADP = CATIA.ActiveDocument.Product
         CATIA.StatusBar = oADP.Name & ": Renaming instances ..."
         
         oADP.ApplyWorkMode DEFAULT_MODE                   'set work mode to expose P/N

         Set oRootProds = CATIA.ActiveDocument.Product.Products

         CATIA.StatusBar = oADP.Name & ": Renaming instances ... First pass ..."
         InstanceEqualName oRootProds, True                'first pass to clear low numbers

         CATIA.StatusBar = oADP.Name & ": Renaming instances ... Second pass ..."
         InstanceEqualName oRootProds, False               'second pass to sort instances

         CATIA.StatusBar = oADP.Name & ": Renaming instances ... Done."
      End If
   Next
   CATIA.Interactive = True                                'allow interaction
   CATIA.Windows.Item(1).Activate

End Sub

'---------------------------------------------------------------------------------------
' Procedure : InstanceEqualName
' Author    : jherzog
' Date      : 19.03.2016
' Time      : 18:53
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose   : Rename product instances to match part name,
'           : while sorting the instances within a product
' Parms     : oProducts: Node of products, eg. 'CATIA.ActiveDocument.Product.Products'
'           : bFirstPass: indicates if first or second pass
' Ret. Value: -
'
' Syntax    : InstanceEqualName oMainProducts, True
'
' Prereqs   : an opened product
' Remarks   :
'---------------------------------------------------------------------------------------
'
Sub InstanceEqualName(oProducts As Products, bFirstPass As Boolean)

   Dim strPNum As String
   Dim strPName As String
   Dim iPos As Integer
   Dim n As Integer
   Dim oinstance As Product


   On Error GoTo InstanceEqualName_Error

   For n = 1 To oProducts.Count

      Set oinstance = oProducts.Item(n)                    'get a product/part
      strPNum = oinstance.PartNumber                       'get part number
'      strPName = oinstance.Name                            'this is the name to change

      If bFirstPass = True Then
         iPos = oProducts.Count + 1                        'first pass clear 'count' positions
      Else
         iPos = 1                                          'second pass assign instances
      End If

      'this causes an error if the instance already exists
      oinstance.Name = strPNum & "." & iPos                'rename instance
      InstanceEqualName oProducts.Item(n).ReferenceProduct.Products, bFirstPass

      If oinstance.Products.Count > 0 Then
         InstanceEqualName oinstance.Products, bFirstPass
      End If
      DoEvents
   Next

   Exit Sub
'---------------------------------------------------------------------------------------
InstanceEqualName_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult

   Select Case Err.Number
      Case -2147467259                                     'couldn't rename instance
         iPos = iPos + 1                                   'increase instance counter
         Resume                                            'try again
      Case Else
         errMsg = Err.Number & ": " & Err.Description & " in procedure InstanceEqualName"
         errRet = MsgBox(errMsg, vbOKOnly, "InstanceEqualName")
   End Select

   'Resume Next                                             'fall thru to quit sub
'---------------------------------------------------------------------------------------
End Sub

Go to top