---

Hallo
ich suche einen lauffähigen Weg um alle sichtbaren Bodies bzw.
sichtbaren Geosets in ein CATPart zu kopieren. = ALLCATPART Manuell.
Die sichtbaren Bodies funktionieren, die sichtbaren GeoSets, mit sichtbarem Inhalt nicht.(Hybridbodies)
Anbei mein Ansatz -

Code:

---

Sub CATMain()
'
    'Abfrage Dokumente
    Set oFenster = CATIA.Windows
    If oFenster.Count = 0 Then
        Box = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgefuehrt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
        Exit Sub
    End If
    Set aktiDoc = CATIA.ActiveDocument
    ObjType = TypeName(aktiDoc)
    If ObjType <> "ProductDocument" Then
        Box = MsgBox("Das aktiv geladene Dokument ist KEIN CATProdukt!" + Chr(10) + "Bitte Laden sie ein CATProdukt und starten sie das Makro erneut!", vbExclamation, "Abbruch falscher Dateityp")
        Exit Sub
    End If
    '
    Dim PathReferenz As String
    Dim Ref As Reference
    '
    Dim ProduktDoc As Product
    Dim Produkt As Product
    Dim i As Integer
    Dim NameErgebnisse  As String
    '
    Set ProduktDoc = CATIA.ActiveDocument
    Set Produkt = ProduktDoc.Product
    ' Design Mode setzen
    Produkt.ApplyWorkMode DESIGN_MODE
    Set Produkte = Produkt.Products
    '
    'Hauptprodukt auswaehlen
    Dim product1 As Product
    Set product1 = ProduktDoc.Product
    NameErgebnisse = product1.name
    '
    'Auflistung der Unterprodukte
    Dim products1 As Products
    Set products1 = product1.Products
    '
    ' Pfad des aktiven Catproducts abfragen
Pfad = CATIA.ActiveDocument.Path     ' Verzeichnis des aktuellen CATParts holen
'
     Dim Selection1 As Selection
     Set Selection1 = ProduktDoc.Selection
    '
    CATIA.Application.DisplayFileAlerts = False
    ' Struktur rekusrsiv durchlaufen
    '
    'Abfrage CATParts vorhanden
    'Msgbox Produkte.count
    If Produkte.count = 0 Then
       Box = MsgBox("Es sind keine CATParts vorhanden!" + Chr(10) + "Das Makro kann nicht ausgefuehrt werden und wird beendet!", vbCritical, "Keine CATParts vorhanden")
       Exit Sub
    End If
    '
    Dim documents1 As Documents
    Set documents1 = CATIA.Documents
    Dim Subprodukt As Produkt
    '
    'Msgbox Produkte.count
    '
    NameAllcatpart = Produkt.name & "_" & Timestamp
    EinfuegenZwischenPart partDocument11, NameAllcatpart
    '
    For k=1 to Produkte.count
      Set Subprodukt = Produkte.item(k)
      If TypeName(Produkte.item(k).ReferenceProduct.Parent) <> "PartDocument" Then
        'Msgbox Subprodukt.name
        ProduktauslesenEX Subprodukt, Produkt, Selection1, product1, partDocument11, NameAllcatpart
     End If
    next
    product1.Update
    SpeichernZwischenPart partDocument11, Pfad, NameAllcatpart
    'OrginalProdukt schliessen ohne Speichern
    ProduktDoc.Close
End Sub
'
'
Sub EinfuegenZwischenPart(partDocument11,NameAllcatpart)
   Dim productDocument1 As Document
   Set productDocument1 = CATIA.ActiveDocument
   Dim product1 As Product
   Set product1 = productDocument1.Product
   Dim products1 As Products
   Set products1 = product1.Products
   Dim product2 As Product
   Set product2 = products1.AddNewComponent("Part", "")
   Dim documents1 As Documents
   Set documents1 = CATIA.Documents
   'Dim partDocument11 As Document
   Set partDocument11 = documents1.Item("Part34.CATPart")
   Dim product3 As CATBaseDispatch
   Set product3 = partDocument11.GetItem("Part34")
   product3.PartNumber = NameAllcatpart
   product2.Name = NameAllcatpart & ".1"
End Sub
'
'
Sub ProduktauslesenEX (Subprodukt, Produkt, Selection1, product1, partDocument11, NameAllcatpart)
For i =1 to Subprodukt.Products.count
      If TypeName(Subprodukt.Products.Item(i).ReferenceProduct.Parent) = "PartDocument" and NOT Subprodukt.Products.item(i).Parent.Parent.name = NameAllcatpart Then
          'Instanzname des aktuellen Parts
          Set Part1 = Subprodukt.Products.Item(i).ReferenceProduct.Parent.Part
          Set Bodies1 = part1.Bodies
          '
          For k=1 to Part1.Bodies.count
                 Set Body1 = Bodies1.Item(k)
                 Set ReferenceObject = Part1.CreateReferenceFromObject(Body1)
                 '
                 PathReferenz =  Subprodukt.Products.Item(i).name & "/!" & bodies1.Item(k).name
                 Set oParent = Subprodukt.Products.Item(i).Parent.Parent
                 PathReferenz = oParent.Name & "/" & PathReferenz
                 Do Until LCase(oParent.Parent.Parent.Name) = "cnext"
                    Set oParent = FUNC_PathToRoot(oParent)
                    PathReferenz = oParent.Name & "/" & PathReferenz
                 Loop
                 Set Ref = product1.CreateReferenceFromName(PathReferenz)
                 '
                 ' Einfuegen ins Zwischenpart
                 Body1.name = Subprodukt.Products.Item(i).Parent.Parent.name & "\" & Subprodukt.Products.Item(i).name & "\" & bodies1.Item(k).name
                 Selection1.Clear
                 Selection1.Add Ref
                 ' Visibility Definition
                 Dim vis As VisPropertySet
                 Set vis = Selection1.VisProperties
                 ' Visibility abfragen
                 Dim showstate As CatVisPropertyShow
                'Dim showstate As CatVisPropertyHide
                 vis.GetShow showstate
                 If (showstate = catVisPropertyShowAttr) Then
                     Selection1.Copy
                     Set PartDocZiel = partDocument11.Part
                     Selection1.Clear
                     Selection1.Add PartDocZiel
                     ' Msgbox PartDocZiel.name
                     ' Body in Part pasten
                     Selection1.PasteSpecial "CATPrtResultWithOutLink"
                 End If
          next
      End If
      If TypeName(Subprodukt.Products.Item(i).ReferenceProduct.Parent) = "ProductDocument" Then
          If Subprodukt.Products.Count > 0 Then
             ProduktauslesenEX Subprodukt.Products.Item(i).Products.Parent, Produkt, Selection1, product1, partDocument11, NameAllcatpart
          End if
     End if
Next
End sub
'
'
Function TimeStamp()
   If Len(CStr(Day(Date))) = 1 Then TimeStamp = TimeStamp & "0"
   TimeStamp = TimeStamp & CStr(Day(Date))
   If Len(CStr(Month(Date))) = 1 Then TimeStamp = TimeStamp & "0"
   TimeStamp = TimeStamp & CStr(Month(Date))
   TimeStamp = TimeStamp & Mid(CStr(Year(Date)), 1, 4)
End Function
'
'
Function FUNC_PathToRoot(oProdOnWayToRoot)
   Set FUNC_PathToRoot = oProdOnWayToRoot.Parent.Parent
End Function
'
'
Sub SpeichernZwischenPart (partDocument11, Pfad, NameAllcatpart)
   Dim documents1 As Documents
   Set documents1 = CATIA.Documents
   '__________________Zielverzeichnis fuer den automatisch auswaehlen___________________
   Dim oFileSys As FileSystem
   Set oFileSys = CATIA.FileSystem
   If (Not oFileSys.FolderExists(Pfad & "\Exported_files\")) Then
       Msgbox "Dieser Ordner existiert nicht!" & Chr(10) & Pfad & "\Exported_files\" & Chr(10) & "Dieser Ordner wird erzeugt!" & Chr(10) & "This folder does not exists!" & Chr(10) & Pfad & "\Exported_files\" & Chr(10) & "This Folder is created!"
       CATIA.FileSystem.CreateFolder(Pfad & "\Exported_files\")
       Targetfolder = Pfad & "\Exported_files\"
   End If
   Targetfolder = Pfad & "\Exported_files\"
   '__________________Löschen von altem AllCATPART______________________________________
   If CATIA.FileSystem.FileExists(Targetfolder & NameAllcatpart & ".CATPart") Then
      'Msgbox "Loeschen"
      CATIA.FileSystem.DeleteFile Targetfolder & NameAllcatpart & ".CATPart"
   End If
   '__________________Speichern AllCATPART______________________________________
   partDocument11.SaveAs Targetfolder & NameAllcatpart & ".CATPart"
End Sub

---

------------------
mfg
Erich

[Diese Nachricht wurde von Erich am 21. Jul. 2024 editiert.]

[Diese Nachricht wurde von Erich am 21. Jul. 2024 editiert.]

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

---

Servus Erich

Was soll denn kopiert werden?
- nur die GeoSets direkt unter dem Part? Oder auch mit verschachtelten Strukturen?
- nur die sichtbaren Element des GeoSets?
- alle Elemente der GeoSets?
- ...

Ich empfehle dir das ganze man erst manuell zu probieren.
Beim "normalen" kopieren und einfügen werden, vermute ich zumindest, zu viele Elemente kopiert (auch ausgeblendete, auch in unter GeoSets, ...)

Gruß
Bernd

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

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

---

Hallo Bernd
Deine Empfehlung erst etwas zu probieren und dann sich an das Forum zu wenden, ist denke ich auch Deiner Meinung nach der richtige Weg.
Deshalb frage ich nach Unterstützung weil manuell bereits viel getestet wurde.
Zu meiner Fragestellung nochmals -
wie ich es beschrieben habe - nur die sichtbaren Elemente des GeoSets(einschließlich GeoSet) mit weiteren sichtbaren Geosets die darin vorhanden sind, sollen kopiert werden.
Das ist meine Frage. Danke

------------------
mfg
Erich

[Diese Nachricht wurde von Erich am 21. Jul. 2024 editiert.]

[Diese Nachricht wurde von Erich am 21. Jul. 2024 editiert.]

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

---

Was für Erfahrungen hast du denn gesammelt beim manuellen Kopieren der GeoSets?
Geht PasteSpecialAsResult? Und sind dann alle Elemente dumm vorhanden?
Wo hakelt dein Code denn?

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

---

Hallo,

in deinem Code werden HybridBodies (GeoSets) ja auch gar nicht berücksichtigt/behandelt, sondern nur Bodies (Körper).

Gruß Randle

------------------
Planung ersetzt Fehler durch Irrtum!

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

---

Hallo
das ist genau das Thema. In der Schleife nehme ich nur die Bodies und kopiere diese in das Zwischenpart. Genau in dieser Schleife möchte ich
die GeoSets, so wie sie im Part sichtbar an erster Stelle im Konstruktionsbaum aufkommen, kopieren.
Wie füge ich das Kopieren, der Geosets in diese Schleife hinzu?
Dazu bräuchte ich einen Tip. Danke

------------------
mfg
Erich

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

---

Servus Erich

Meiner Ansicht nach kannst du nicht einfach das GeoSet kopieren und einfügen, weil er sonst alle Elemente (auch die ausgeblendeten), mit kopiert und isoliert eingefügt werden.
Deshalb meine Frage/Hinweis: Teste es erst manuell und beschreib dann was du genau möchtest.

Mein Ansatz wäre:

• Part-Instanz selektieren
  
• in der Selektion nach sichtbaren Flächen suchen (Makrorekorder)
  
• Selektierte Elemente in einem Array zwischenspeichern
  
• für die Elemente aus dem Array die Referenzen bilden (die für die Körper
  
• über Referenz selektieren/kopieren und in Zielpart einfügen (GeoSet zuvor erzeugen)
  
• ggf können alle Element auf einmal kopiert/eingefügt werden (muss getetstet werden)

Dabei würden aber alle sichtbaren HybridshapeFaces kopiert werden. Es gäbe nur ein GeoSet in das alles reinkommt.
Ist das, dass was du willst?

Gruß
Bernd

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

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

---

Hallo,

also ohne eine separate Schleife über die HybridBodies eines jeden Parts, wirst du wohl nicht umzukommen. Ich würde die GeoSets als ganzes kopieren und dann abschließend über das Ergebnis (im AllCatPart) gehen und alle unsichtbaren HybridShapes löschen. Ist glaube ich einfacher als vorher zu "filtern".
Gruß Randle
PS: Das mit den Referenzen könnte tatsächlich ein Problem sein und es doch notwendig machen jedes Element einzeln zu kopieren. Ich hatte das jetzt nur an dem denkbar einfachsten Fall getestet.
------------------
Planung ersetzt Fehler durch Irrtum!

[Diese Nachricht wurde von Randle am 22. Jul. 2024 editiert.]

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

---

Hallo Bernd
1.Gedanke
Deine Überlegung die Elemente in ein Array zu kopieren, hat bei mir folgende Überlegung gebracht.
Alle Bodies, bzw. Hybridbodies nach ihrem Auftreten im Baum, nacheinander in ein Array einzufügen und von da ins Zwischenpart kopieren.
Hier fehlt mir der Ansatz wie schaffe ich die Reihenfolge, bzw. wie kann ich Bodies und Hybridbodies in ein Array ablegen!?
2.Gedanke
Generate Part From Produkt verwenden. Problematik hier ist, wenn ich mehrere Produkte in ein ALLCATPART überführen will, wie ich das meinem Script erzähle.
Gibt es hierzu vieleicht ein Beispiel.

------------------
mfg
Erich

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

---

Hallo Randle
diese Überlegungen finde ich nachvollziehbar. Werde ich versuchen umzusetzen.

------------------
mfg
Erich

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

---

Servus Erich

zB über:

Code:

---

selection1.Search "(CATPrtSearch.BodyFeature.Visibility=Visible + CATPrtSearch.OpenBodyFeature.Visibility=Visible),all"

---

kannst du alle sichtbaren Körper und GeoSet selektiere und danach in ein Array packen.
ABER
- wenn die Part-Instanz ausgeblendet ist wird das GeoSet/Körper auch selektiert
- löst das nicht die Thematik mit den ganzen Subelementen des GeoSets
- das erstellen der Referenzen zum selektieren und kopieren muss du weiterhin machen

zu deiner 2:
"Generate Part From Produkt" benötigt um dies per Makro auszuführen inzwischen eine extra Lizenz.
Hast du diese? Wenn ja, warum treibst du diesen großen Aufwand?

Gruß
Bernd

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

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

---

Hallo Bernd
welche Lizenz wird hierfür benötigt und gibt es unter V5R32 ein lauffähiges Beispiel?
Dann könnte ich meine Überlegungen verkürzen.

------------------
mfg
Erich

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

---

Servus Erich

die DF1-Lizenz
Für Code-Beispiele: such mal hier im Forum nach DECProductToPart

Gruß
Bernd

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

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