---

Hallo zusammen!

Ich möchte gerne einen gesamten Strukturbaum durchsuchen und beim Auffinden von Products die zugehörigen Hauptkörper der Parts umbenennen.
Mein Ansatz wäre ein rekursives Durchforsten des Baums, allerdings schaffe ich es nicht auf die Parts zuzugreifen und zu unterscheiden ob das Item ein Part oder Product ist.

Hier mein bisheriger Code:

Code:

---

Sub CATMain()
    Dim Doc1 As Document
    Set Doc1 = CATIA.ActiveDocument
    Dim Typ As String

        'Abfrage ob aktuelles Dokument ein Part oder Product ist
    Typ = Doc1.Name
    Typ = Right(Typ, Len(Typ) - InStr(Typ, "."))
   
    If StrComp(Typ, "CATPRODUCT", vbTextCompare) = 0 Then
        ' PRODUCT
        Dim Product1 As Product
        Set Product1 = Doc1.Product
        Call RunTree(Product1)
               
    ElseIf StrComp(Typ, "CATPART", vbTextCompare) = 0 Then
        ' PART
        Dim part1 As Part
        Set part1 = Doc1.Part
        Call RenameSolid(part1)
    End If
   
End Sub

Private Sub RunTree(Product1 As Product)
    For i = 1 To Product1.Products.Count
        MsgBox Product1.Products.Item(i).Name

        If ****Product1.Products.Item(i).Type? = "Product" **** Then
            Call RunTree(Product1.Products.Item(i))
        ElseIf ****Product1.Products.Item(i).Type? = "Part" **** Then
            Call RenameSolid(Product1.Products.Item(i))
        Else
            'other
        End If
    Next
End Sub

Private Sub RenameSolid(Part1 As Part)
    ....Hauptkörper umbenennen
End Sub

---

Ich bekomm das PART Object einfach nicht aus dem Product raus da 'Product1.Products.Item(i)' ja wieder ein Product ist.
Wär toll wenn jemand ne Idee hätte!

gruß ap

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

---

Hallo apollo11,

die besagten Zeilen sollten aus meiner Sicht

Code:

---

If TypeName(Product1.Products.Item(i).referenceProduct.parent) = "ProductDocument" Then

---

bzw.

Code:

---

ElseIf TypeName(Product1.Products.Item(i).referenceProduct.parent) = "PartDocument" Then

---

lauten, dann sollte es funktionieren!

mfg,
Lusilnie

------------------

Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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

---

Funktioniert einwandfrei!
Ich hab dazu noch was im Forum gefunden:
http://ww3.cad.de/foren/ubb/Forum137/HTML/001168.shtml#000004

tomtom1972 schreibt da man soll zuerst alle Nodes deaktivieren, dann die Aktionen durchführen und danach wieder alles aktivieren.
Ich kann den tieferen Sinn dabei nicht erkennen... Es funktioniert auch ohne ?!?

lg ap

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

---

Hallo apollo11,

dein Link funktionoiert zwar bei mir nicht, aber wenn ich mich recht erinnere war das Deaktivieren der Nodes die Lösung eines anderen Problems: Wenn du Geometrie aus einer Struktur kopieren möchtes erhält diese eine falsche Transformation (ist also im Raum falsch positioniert), sofern ein und das selbe Part in einen Product öfter instantiert ist und zudem eine unterschiedliche Transformation hat.

Mit deinen Problem hat das nix zu tun.

Gruss TomTom

------------------
tomtom1972

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

---

Etwas alt aber ich habe da ein Problem:

Code:

---

Sub CATMain()
    Dim Doc1 As Document
    Set Doc1 = CATIA.ActiveDocument
 
    Dim UserSelection As Object
    Dim AlleKoerper As Integer
    Dim a          As Integer
    Dim Speicherpfad As String
    Dim Dateiname As String
   
    Dim Typ        As String

   
    '-- Speicherpfad
    Speicherpfad = InputBox("Bitte den Pfad eigeben, wo das Versandmodell gespeichert werden soll.", "Eingabe Dateipfad und Name")
    Speicherpfad = Speicherpfad & "\"
   
    '-- Product, Parts rekursiv durchgehen
    '-- Abfrage ob aktuelles Dokument ein Part oder Product ist
    Typ = Doc1.Name
    Typ = Right(Typ, Len(Typ) - InStr(Typ, "."))
   
    If StrComp(Typ, "CATPRODUCT", vbTextCompare) = 0 Then
        ' PRODUCT
        Dim Product1 As Product
        Set Product1 = Doc1.Product
        Call RunTree(Product1)
       
    ElseIf StrComp(Typ, "CATPART", vbTextCompare) = 0 Then
        ' PART
        Dim part1 As Part
        Set part1 = Doc1.Part
        Call KoerperToeten(part1)
    End If
   
End Sub

Private Sub RunTree(Product1 As Product)
    For i = 1 To Product1.Products.Count
        MsgBox Product1.Products.Item(i).Name
       
        If TypeName(Product1.Products.Item(i).ReferenceProduct.Parent) = "ProductDocument" Then
            Call RunTree(Product1.Products.Item(i))
        ElseIf TypeName(Product1.Products.Item(i).ReferenceProduct.Parent) = "PartDocument" Then
            Call KoerperToeten(Product1.Products.Item(i))
        Else
            'other
        End If
    Next
End Sub

Private Sub KoerperToeten(part1 As Part)
   
    '-- Part
   
    Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
   
    Set part2 = partDocument1.Part
    Dim bodies1    As Bodies        'solids
    Set bodies1 = part2.Bodies
   
    Dim shapeFactory1 As ShapeFactory        'solids
    Set shapeFactory1 = part2.ShapeFactory
   
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part2.HybridBodies
   
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part2.HybridShapeFactory

    Set UserSelection = partDocument1.Selection
    UserSelection.Clear
   
    AlleKoerper = bodies1.Count
    Dateiname = partDocument1.Product.PartNumber
   
   
    Dim BodyArrayAlle()
    ReDim BodyArrayAlle(AlleKoerper)
   
    For a = 1 To AlleKoerper
        Set BodyArrayAlle(a) = bodies1.Item(a)
    Next
    UserSelection.Clear
   
    '-- Alle Koerper kopieren und tot einfügen
    For a = 1 To UBound(BodyArrayAlle)
        If BodyArrayAlle(a).InBooleanOperation = False And Not (BodyArrayAlle(a) Is part2.MainBody) Then
            UserSelection.Add BodyArrayAlle(a)
        End If
       
    Next

---

Ich bekomme bei Call KoerperToeten(Product1.Products.Item(i)) einen Type mismatch.
Woher kommt der?

Kann ich in  Private Sub KoerperToeten(part1 As Part) einfach so weiter coden, als wie wenn ich ein Makro für ein Part schreiben würde, oder muss ich dieses Part, welches rekursiv gefunden wurde erst mal ansprechen?

Danke schon mal

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

---

Servus

Du übergibst an die Unterroutine ein Product (die Instanz). Erwartet wird aber das Part.
Probier mal:
Call KoerperToeten(Product1.Products.Item(i).ReferenceProduct.Parent.Part)

Zitat:

---

Kann ich in  Private Sub KoerperToeten(part1 As Part) einfach so weiter coden

---

Da du das Part übergibst kannst du weitestgehend so programmieren wie wenn du in einem aktiven PartDocument bist.
Vermutlich musst du aber die Selection des aktiven Dokuments (Set UserSelection = Catia.ActiveDocument.Selection) nutzen und nicht die vom PartDocument

Gruß
Bernd

PS: Was passiert wenn das Einzelteil mehrfach in der Baugruppe verbaut ist?

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

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

---

Super hat geklappt danke!

Das mit den doppelten Parts ist mir in dem Fall egal, dann überspeichert er die Datei einfach.

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