Das VBA-Makro korrigiert nach zB 'Component Replace' widersprüchliche Instanzennamen aller Kindern des ausgewählten Produktes,
nicht jedoch die Enkel, Neffen, Cousinen und sonstige Verwandtschaft.
Der Code:
'---------------------------------------------------------------------------------------
' Module : modInstEqNameOneLevel
' Author : jherzog
' Date : 16.04.2016
' Purpose : Rename/sync instances of all child products in the next level
' : while sorting the instances within a product
'---------------------------------------------------------------------------------------
Option Explicit
Sub CatMain()
Dim oRootProds As Products
Dim oSel As Selection
Dim oPP
CATIA.Interactive = False 'no interaction allowed
Set oSel = CATIA.ActiveDocument.Selection
If oSel.Count2 = 0 Then 'anything selected?
MsgBox "No product selected!" & vbCrLf _
& "You need to select a product" & vbCrLf _
& "before reading the list!", _
vbOKOnly Or vbCritical, "ReadList"
Exit Sub
Else
Set oPP = oSel.Item2(1)
Select Case oPP.Type
Case "Product"
'check if part or product
If TypeName(oPP.Value.ReferenceProduct.Parent) = "ProductDocument" Then
CATIA.StatusBar = oPP.Value.Name & ": Renaming instances ..."
oPP.Value.ApplyWorkMode DEFAULT_MODE 'set work mode to expose P/N
Set oRootProds = oPP.Value.ReferenceProduct.Products
CATIA.StatusBar = oPP.Value.Name & ": Renaming instances ... First pass ..."
InstanceEqualName oRootProds, True 'first pass to clear low numbers
CATIA.StatusBar = oPP.Value.Name & ": Renaming instances ... Second pass ..."
InstanceEqualName oRootProds, False 'second pass to sort instances
CATIA.StatusBar = oPP.Value.Name & ": Renaming instances ... Done."
Else 'part instance selected
MsgBox "No product selected!" & vbCrLf _
& "You need to select a product" & vbCrLf _
& "before reading the list!", _
vbOKOnly Or vbCritical, "ReadList"
oSel.Clear
Exit Sub
End If
Case Else 'selection was not a product
MsgBox "No product selected!" & vbCrLf _
& "You need to select a product" & vbCrLf _
& "before reading the list!", _
vbOKOnly Or vbCritical, "ReadList"
oSel.Clear
Exit Sub
End Select
End If
CATIA.Interactive = True 'allow interaction
End Sub
'---------------------------------------------------------------------------------------
' Procedure : InstanceEqualName
' Author : jherzog
' Date : 19.04.2016
' Time : 20:00
' 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
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