---

Beispiel.JPG

Hallo,
der User möchte ein Makro haben, um von einer importierten Step-Datei die PartNumber und Description neu zusammenzufügen und wieder in die PartNumber und Description einzufügen. Die PartNumber wird dann später durch eine Teamcenter Nummer beim speichern überschrieben. Beispiel siehe Anhang.
Mein Macro funktioniert auch und rauscht durch die Struktur und führt die Änderungen aus. Nur bei Gleichteilen wird der neu zusammengesetzte Text mehrfach eingefügt und das ist leider mein Problem wo ich nicht weiter kommen. Ich bin kein professioneller Programmierer und wäre dankbar, wenn mir jemand helfen könnte. Anbei das Script:

Sub CATMain()

On Error Resume next

Dim version, makroname
version = "1.0"
makroname = "Rename_Properties_Assembly_Step"

CATIA.StatusBar = "Macro: " & makroname & "  " & "Version: " & version

'***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
Dim oDoc As Document
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

'****Baugruppe in Design_Mode laden
Dim oDoc1 As Product
Set oDoc1 = oDoc.Product
oDoc1.ApplyWorkMode DESIGN_MODE

set Sel = CATIA.ActiveDocument.Selection
Sel.Search "(CATProductSearch.Product),all"

Text_All_01 = "Start"

'Das Makro funktioniert nicht für Gleichteile, dort wird der zusammengestzte Text mehrfach in oDoc1.PartNumber und oDoc1DescriptionRef eingefügt
for i = 1 to Sel.Count 
  set oDoc1 = Sel.FindObject("CATIAProduct")
  'MsgBox oDoc1.PartNumber  ' gibt die PartNumber (Name) aus
 
  Text_PartNumber_1 = oDoc1.PartNumber
  Text_DescriptionRef_1 = oDoc1.DescriptionRef
  Text_All = Text_PartNumber_1 & "-" & Text_DescriptionRef_1
 
  'MsgBox "Text_All: " & Text_All & "  Text_All_01: " & Text_All_01
   

If Text_All = Text_All_01 Then

MsgBox "Keine Änderung!"

else
   
oDoc1.PartNumber = Text_All
oDoc1.DescriptionRef = Text_All


End If

Text_All_01 = Text_PartNumber_1 & "-" & Text_DescriptionRef_1
 
next

'---Abschlussmeldung an Anwender --------------------'
 
  MsgBox "Makro ist beendet", vbInformation, makroname + " " + version

End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Zur Info: Du gehst nicht rekursiv durch die Baugruppe, sondern suchst alle Products (Instanzen).
Ich hab folgende Ideen wie du das lösen könntest:

• du machst dir eine "Liste" (zB Dictonary) der Products in der diese nur einmal vorkommen, diese arbeitest du dann zum Umbenennen ab
  
• du lässt dein Makro so, und überprüfst nur vor dem Umbenennen ob diese schon umbenannt wurden (zB ersten paar Zeichen auslesen und auswerten oder Liste mit den schon umbenannten führen)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke Bernd, ich hatte doch noch eine Eingebung und jetzt funktioniert es. Mir wurde hier auch schon oft geholfen, daher füge ich das funktionierende CATScript hier ein. Vielleicht kann es jemand gebrauchen oder als Ideengeber verwenden.

Sub CATMain()

'On Error Resume next

Dim version, makroname
version = "1.0"
makroname = "Rename_Properties_Assembly_Step"

CATIA.StatusBar = "Macro: " & makroname & "  " & "Version: " & version

'***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
Dim oDoc As Document
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

'****Baugruppe in Design_Mode laden
Dim oDoc1 As Product
Set oDoc1 = oDoc.Product
oDoc1.ApplyWorkMode DESIGN_MODE

'****Start der Suche rekursiv durch die Struktur
set Sel = CATIA.ActiveDocument.Selection
Sel.Search "(CATProductSearch.Product),all"

for i = 1 to Sel.Count 
  set oDoc2 = Sel.FindObject("CATIAProduct")
 
  'Vergleich von PartNumber und DescriprinsRef um Gleichteile bei der Umbenennung auszuschließen 
  If oDoc2.PartNumber = oDoc2.DescriptionRef Then
 
'Soll hier nichts machen!

  Else
'PartNumber und DescriptionRef werden als String zusammengefasst und in eine Variable gespeichert
  Text_PartNumber_1 = oDoc2.PartNumber
Text_DescriptionRef_1 = oDoc2.DescriptionRef
Text_All = Text_PartNumber_1 & "-" & Text_DescriptionRef_1
     
'PartNumber und DescriptionRef werden umbenannt
oDoc2.PartNumber = Text_All
oDoc2.DescriptionRef = Text_All

End If

 
next

'---Abschlussmeldung an Anwender --------------------'
 
  OutPut = OutPut & "The macro is finish and will be closed!" & CHR(10)
  OutPut = OutPut &"-----------------------------------" & CHR(10)
  OutPut = OutPut &"-----------------------------------" & CHR(10)
  OutPut = OutPut &"macro written by:" & CHR(10)
  OutPut = OutPut &"*****************" & CHR(10)
  OutPut = OutPut &"-----------------------------------" & CHR(10)
  OutPut = OutPut &"-----------------------------------" & CHR(10)
  OutPut = OutPut &"Copyright: ***********+"

MsgBox OutPut, 64, makroname + " " + version

End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP