Das VBA-Makro 
korrigiert nach zB 'Component Replace' widersprüchliche Instanzennamen aller in Catia geladenen Produkte.
Wer schon mal Befestigungselemente mit 'Component Replace' ausgetauscht hat, kennt das Problem.
Nach dem Austausch passt der Instanz-Name nicht mehr zur PartNumber.
Das Makro gleicht den Instanzen-Namen an die PartNumber an.
Der 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