---

Hallo zusammen,
ich bin aktuell dabei ein Makro zu schreiben und komme leider nicht weiter. Vielleicht könnt ihr mir ja auf die Sprünge helfen.

Die Situation ist wie folgt.

Schritt 1: Nach dem ausführen des Makros soll der Körper, welcher as Result in das aktive Part kopiert werden soll, ausgewählt werden.
Schritt 2: Der ausgewählte körper wird as Result in das Part kopiert und in "ALT" umbenannt.
Schritt 3: Um die Farben "zurückzusetzen" soll ein reset properties mit apply to all children ausgeführt werden.

Vielen Dank schonmal vorab für eure Hilfe.

Grüße Tobi

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

---

Hallo,

und wo genau hakt es jetzt?
Wie sieht dein Quellcode bislang aus?
Welche Fehlermeldung gibt es?

Gruß
Randle

------------------
Wer für nichts steht, fällt für alles!

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

---

Hallo,
er weiter als die Selektion und das kopieren habe ich noch nicht richtig hinbekommen.

Das Makro sieht wie folgt aus:

Language="VBSCRIPT"

Sub CATMain()

set Sel = CATIA.ActiveDocument.Selection
dim ObjektTyp(0)
ObjektTyp(0) = "Body"
Sel.Clear
do      ' Do...LOPP-Schleife
    Auswahl = Sel.SelectElement2(ObjektTyp,"Fertigteil auswählen" , false)
    if Auswahl =  "Normal" then 
      set Objekt = Sel.item(1)
      Fertig = true
  else
      Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _
        "Das Makro wurde beendet!", 48,  "Benutzerabbruch")
      exit Sub
  end if
loop until Fertig = true

CATIA.ActiveDocument.Selection.Copy()

CATIA.ActiveDocument.Selection.PasteSpecial "CATPrtResultWithOutLink"

End Sub

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

---

Hallo,

ich habe deinen Code ein wenig angepasst/erweitert:

Code:

---

Language = "VBSCRIPT"

Sub CATMain()

Set oPartDoc = CATIA.ActiveDocument
Set oPart = oPartDoc.Part

Set Sel = oPartDoc.Selection
Dim ObjektTyp(0)
ObjektTyp(0) = "Body"
Sel.Clear
Do      ' Do...LOPP-Schleife
    Auswahl = Sel.SelectElement2(ObjektTyp, "Fertigteil auswählen", False)
    If Auswahl = "Normal" Then
      Set Objekt = Sel.Item(1)
      Fertig = True
  Else
      Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _
        "Das Makro wurde beendet!", 48, "Benutzerabbruch")
      Exit Sub
  End If
Loop Until Fertig = True

Sel.Copy
Sel.PasteSpecial "CATPrtResultWithOutLink"
Sel.Clear
oPart.Bodies.Item(oPart.Bodies.Count).Name = oPart.Bodies.Item(oPart.Bodies.Count).Name & "_ALT"
Sel.Add oPart.Bodies.Item(oPart.Bodies.Count)

'Variante 1
For Each oShape In oPart.Bodies.Item(oPart.Bodies.Count).Shapes
    Sel.Add oShape
Next
Sel.VisProperties.SetRealColor 255, 255, 255, 0

'Variante 2 'Alternative zu VisProperties, allerdings muss hier noch ein Dialog manuell bestätigt werden
'CATIA.StartCommand "Reset Properties"
Sel.Clear
End Sub

---

Der Befehl "Reset Properties" lässt sich meines Wissens nach nicht so einfach automatisieren. Aber vielleicht weiß hier jemand aus dem Forum noch was.

Gruß
Randle

------------------
Wer für nichts steht, fällt für alles!

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

---

Zuerst einmal vielen Dank.

Die erste Variante funktioniert sehr gut. Das einzige Problem besteht darin, dass wenn der Hauptkörper den ich kopieren möchte nicht eingefärbt ist, sondern z.B. ein Pad welches sich in ihm befindet, übernimmt er nicht die Farbe aus dem Makro, sondern behält die des Pads.

Zu Variante 2. Die habe ich leider nicht ans laufen bekommen.

Liebe Grüße

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

---

in welcher Sprache betreibst du CATIA?

------------------
Wer für nichts steht, fällt für alles!

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

---

Auf englisch.

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

---

Ok, dann weiss ich auch nicht warum es nicht geht, müsste ich wahrscheinlich selbst davorsitzen.

Noch mal zu dem Thema mit den Pads und deren Farbe. Darum hatte ich die "For each oShape" dort eingebaut.

Gruß
Randle

------------------
Wer für nichts steht, fällt für alles!

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

---

Das scheint er aus irgendeinem Grund auch nicht zu machen.

Besteht eigentlich auch die Möglichkeit so zu programmieren, dass ein Part nicht im separaten Fester geöffnet sein muss um das Makro auszuführen?

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

---

Ja.

------------------
Wer für nichts steht, fällt für alles!

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

---

Hättest du denn ggf. noch einen Lösungsansatz? Ich bin dan leider mit meinem Latein am Ende.

Liebe Grüße 

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

---

Servus

Schon mal die Forensuche bemüht?
Dann hättest du zB diese Beispiel gefunden.

Gruß
Bernd

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

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

---

Hallo,
natürlich habe ich die Suche benutzt.

Ich babe auch schon ein paar Dinge probier, doch leider bekomme ich das nicht wie gewollt ans laufen.

LG

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

---

Hallo,

das hier sollte funktionieren.

Code:

---

Language = "VBSCRIPT"
Sub CATMain()

On Error Resume Next
Set oDoc = CATIA.ActiveDocument
If Err.Number <> 0 Then
  MsgBox "Kein Dokument gefunden", vbInformation, "Programmabbruch"
   Exit Sub
End if
On Error Goto 0
If TypeName(oDoc) = "PartDocument" Then
    Set oPartDoc = oDoc
    Set oPart = oPartDoc.Part
Else
    If TypeName(oDoc) <> "ProductDocument" Then
        MsgBox "Falscher Dokumententyp", vbInformation, "Programmabbruch"
        Exit Sub
    End If
End If

Set sel = oDoc.Selection

Dim ObjektTyp(0)
ObjektTyp(0) = "Body"
sel.Clear
Do      ' Do...LOPP-Schleife
    Auswahl = sel.SelectElement2(ObjektTyp, "Fertigteil auswählen", False)
    If Auswahl = "Normal" Then
      Set Objekt = sel.Item(1)
      Fertig = True
  Else
      Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _
        "Das Makro wurde beendet!", 48, "Benutzerabbruch")
      Exit Sub
  End If
Loop Until Fertig = True

Set oBody = sel.Item(1).value

Set oDocument = oBody.Parent.Parent.Parent

Do Until TypeName(oDocument) = "PartDocument"
    Set oDocument = oDocument.Parent
Loop

Set oPartDoc = oDocument
Set oPart = oPartDoc.Part

sel.Copy
sel.PasteSpecial "CATPrtResultWithOutLink"
sel.Clear
oPart.Bodies.Item(oPart.Bodies.Count).name = oPart.Bodies.Item(oPart.Bodies.Count).name & "_ALT"
sel.Add oPart.Bodies.Item(oPart.Bodies.Count)

'Variante 1
For Each oShape In oPart.Bodies.Item(oPart.Bodies.Count).Shapes
    sel.Add oShape
Next
sel.VisProperties.SetRealColor 255, 255, 255, 0

'Variante 2 'Alternative zu VisProperties, allerdings muss hier noch ein Dialog manuell bestätigt werden
'CATIA.StartCommand "Reset Properties"
oPart.Update
sel.Clear
End Sub

---

Man hätte auch den Anwender als erstes das zu bearbeitende Part auswählen lassen, aber so haben wir eine Anwenderauswahl weniger. Die Schleife habe ich eingebaut falls der ausgewählter Körper nicht im Partroot (erste Ebene) liegt, sondern in einen anderen Körper "geboolt" wurde. Der neue Körper (die Kopie) wird allerdings im Partroot eingefügt. Abschließend habe ich noch ein Update des Parts eingefügt.

Viel Erfolg noch
Gruß
Randle

------------------
Wer für nichts steht, fällt für alles!

[Diese Nachricht wurde von Randle am 07. Sep. 2018 editiert.]

[Diese Nachricht wurde von Randle am 07. Sep. 2018 editiert.]

[Diese Nachricht wurde von Randle am 07. Sep. 2018 editiert.]

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

---

@Randle

Vielen Dank! Funktioniert prima 
Das ist genau das was ich gesucht habe.

Grüße Tobi

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