Code:
' Makro: Instanzen_Umbenennen.CATScript
' Version: 1.0
' Code: CATIA CATScript
' Zweck: Erstellt die Exemplarnamen einer Baugruppe und in deren Komponenten.
' Benennungsschema: PartNumer + . + Zähler
' Autor: bgrittmann
' Datum: 26.11.2010
'------------------------------------------------------------------------------------CATIA.StatusBar = "Instanzen_Umbenennen.CATScript, Version 1.0"
Sub CATMain()
Dim oDoc As ProductDocument
Dim oProduct As Product
Dim oProducts As Products
Dim Setting As SettingController
'***Abfrage nach geöffnetem Dokument
If CATIA.Windows.Count = 0 Then
MsgBox "Es ist kein Dokument geöffnet." + vbNewLine + "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Kein Dokument offen"
Exit Sub
End If
'***Auslesen der Dokumentart
Set oDoc = CATIA.ActiveDocument
If TypeName(oDoc) <> "ProductDocument" Then
MsgBox "Dieses Dokument ist kein CATProduct." + vbNewLine + "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Falscher Dokumententyp"
Exit Sub
End If
'Umbenennen aufrufen
Set oProduct = oDoc.Product
Set oProducts = oProduct.Products
Instanz_Umbenennen oProducts
End Sub
Private Sub Instanz_Umbenennen(ByRef prodProducts As Products)
'Erstellt die Exemlarnamen neu, bestehend aus PartNumber+.+Zähler
Dim oProduct As Product
Dim i, j, intcount As Integer
Dim StrPartNumber As String
Dim bCache As Boolean
'Cache-Mode aktiv?
bCache = CATIA.SettingControllers.Item("CATSysCacheSettingCtrl").ActivationMode
'Exemplarnamen löschen
For i = 1 To prodProducts.Count
prodProducts.Item(i).Name = "temp2" & CStr(i)
'bei aktiviertem Cache-Mode, Teil in den DEFAULT_MODE wechseln
If bCache = 1 Then
prodProducts.Item(i).ApplyWorkMode DEFAULT_MODE
End If
Next
'Exemplare der Reihe nach umbenennen
For i = 1 To prodProducts.Count
Set oProduct = prodProducts.Item(i)
'Abfrage ob temporärer Name gesetzt
If Left(oProduct.Name, 4) = "temp" Then
Set oProduct = prodProducts.Item(i)
'Zähler initialisieren
intcount = 1
StrPartNumber = oProduct.PartNumber
oProduct.Name = StrPartNumber & "." & intcount
'Alle Komponenten unterhalb (>i) auf gleiche PartNumber prüfen
For j = i + intcount To prodProducts.Count
If StrPartNumber = prodProducts.Item(j).PartNumber Then
intcount = intcount + 1
prodProducts.Item(j).Name = StrPartNumber & "." & intcount
End If
Next
End If
'oProduct ist eine Komponenten?
If TypeName(oProduct.ReferenceProduct.Parent) <> "PartDocument" Then
'If oProduct.ReferenceProduct.Parent.Name = oProduct.Parent.Parent.ReferenceProduct.Parent.Name Then
'Sub rekursiv aufrufen
Instanz_Umbenennen oProduct.ReferenceProduct.Products
'End If
End If
Next
End Sub