---

B1.jpg

Guten Morgen.

Bin mir nicht sicher ob ich hier im "CATIA V5 Programmierung"-Forum mit diesem Problem richtig bin......

Ich muss in einem CatPart geometrisch gleiche und gespiegelte Körper finden und markieren/umbenennen.

Gleichteile finde ich wenn ich das Volumen, die Oberfäche(Bereich) und die Hauptträgheitsmomente (vorrausgesetzt gleiches Material)vergleiche,
jedoch haben die gespiegelten Körper natürlich die gleichen Eigenschaften und werden als Gleichteile gekennzeichnet.

Kennt jemand einen Weg die Gleichteile von den Gespiegelten zu unterschieden??

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Servus

Wurden die Körper bzw Parts schon vor dem erstellen des AllCatParts gespiegelt? Sonst könntest du ja nach dem Spiegelungs-Feature suchen.

Ist denn bekannt an welcher Ebene gespiegelt wird?
Dann könntest du ggf eine Koordinate des Schwerpunktes auswerten (zB +x = Orginal, -x = Spiegelung). Geht aber nur wenn die Teile weit genug von der Spiegelebene entfernt sind.

Weitere Ansatz: Kannst du anhand der Reihenfolge im Baum folgern welcher Körper das "Original" ist?

Gruß
Bernd

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

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

---

Hallo Bernd.

Ja es wird schon vorher gespiegelt bzw. wir erhalten die CAD-Daten so.
Die Spiegelungsebenen sind nicht immer bekannt bzw. es gibt mehrere/verschiedene Speigelungsebenen.
Wenn ICH persönlich die Bauteile zb. in Y (ZX-Ebene) spiegle vergleiche ich die Y+- Werte des Schwerpunkts.

Für die Gleichteile nehme ich immer das 1. Bauteil im Baum als "Original" an.

mein erster Lösungsansatz:
1.am Originalteil Schwerpunkt und Achssystem erzeugen
2.Schwepunkt und Achssystem am 2.Bauteil erzeugen.
3.Bauteile mit Transformationskomp-ACHSE zu ACHSE übereinanderlegen.
4.mit Boolischen Operationen "Hinzufügen" vereinen und den entstandenen Körper dann prüfen
5.Wenn Eigenschaften Vol/Oberfläche und Hauptmomente sich ändern = Gespigelt wenn sie gleich bleiben = GT

jedoch müsste ich da ein neues CatPart erzeugen und die jeweiligen Körper ins neue Part kopieren und vergleich....sehr lange Laufzeit

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Hallo,

wenn die Gleichteile im Raum verschoben/verdreht sind, könnte es sein, das die Ausrichtung der Achsen nicht mehr passt und diese beim AxsToAxs nicht mehr übereinander liegen.
Du könntest statt einen Add ein Intersect verwendet dann sollten Gleichteile "leer" sein... ist aber das gleiche...

Warum kannst du das nicht im gleichen Part machen? Deine Hilfselement könntest du doch wieder löschen.

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

B2.jpg

Hallo Mario.

Wenn man den Schwerpunkt und Achsen bei der Trägheitsmessung erstellt (siehe Bild),
passen die Achsen zueinander (auch wenn verschoben und verdreht) bei Gleichteilen und bei Gespiegelten sind sie um den Schwerpunkt verschoben.... Dadurch ergibt sich dann dieser Volumen- bzw Oberflächenunterschied.

Natürlich geht es auch im gleichen Part, ich wollte halt die Originaldatei "sauber" halten.
Ich glaub es kommt nicht auf die Zeit von 1x neues Part erstellen, sondern das hin und her kopieren von den Bauteilen.

mfg
Dragan

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Achsen_Gleichteile.PNG

Hallo Dragan,

also bist du dir da sicher? Bei mir passt das nicht. (siehe Bild)
Das Gleichteil habe ich 90° gedreht und 1000mm verschoben.
Man sieht das die X-Achse einmal zur Rundung zeigt und einmal nicht.
Die Achsen sind bei der Messung erstellt.

Davon mal abgesehen, es gibt auch gespiegelte Teile die Gleichteile sein können... Kommt drauf an um welche Teile es sich bei dir handelt...

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

B3.jpg

Hallo.

Also bei mir passt es...siehe Bild
hab es ein paar mal probiert

Wenn der Bauteil in sich symmetrisch ist und der Schwerpunkt usw. passen wird er e als GT erkannt.

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Kopier mal den verschobenen Bauteil und füg ihn als "Dummen" Körper ein....also ohne Informationen.

Zitat:

---

Original erstellt von roccat:
Hallo Dragan,

also bist du dir da sicher? Bei mir passt das nicht. (siehe Bild)
Das Gleichteil habe ich 90° gedreht und 1000mm verschoben.
Man sieht das die X-Achse einmal zur Rundung zeigt und einmal nicht.
Die Achsen sind bei der Messung erstellt.

Davon mal abgesehen, es gibt auch gespiegelte Teile die Gleichteile sein können... Kommt drauf an um welche Teile es sich bei dir handelt...

mfG
Mario

---

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Achsen_Gleichteile_45.PNG Achsen_Gleichteile_70.PNG

Ich glaube du hast zu wenig gedreht...

Anbei 2 Bilder:
45° gedreht = OK
70° gedreht = nOK

Wenn das Achsensystem zu einer Internen Referenz in einen neuen "Sektor" gedreht wird, ändern sich öfters mal Elemente ihr Ausrichtung, das ist nicht nur bei dem Achsensystem so.

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

Danke Mario.

Leider hast du Recht...

Hat jemand Ideen?

Würde es funktioneren die Körper zuerst am Schwerpunkt auf 0 zu verschieben und dann Achsen zusetzen....?

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Zitat:

---

Kopier mal den verschobenen Bauteil und füg ihn als "Dummen" Körper ein....also ohne Informationen.

---

gleiches Ergebnis... auch Falsch...

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

Funktioniert auch nicht...

Zitat:

---

Original erstellt von BLD1983:
Danke Mario.

Leider hast du Recht... 

Hat jemand Ideen?

Würde es funktioneren die Körper zuerst am Schwerpunkt auf 0 zu verschieben und dann Achsen zusetzen....?

---

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Wie sehen denn deine Teile in der Regel aus?

Evtl. kann man was über die Teilflächen machen ist aber Aufwändig und rechnet auch länger...

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

Ich würde trotzdem bei deiner Variante bleiben und nach dem AxsToAxs noch ein Rotate machen und immer in 90° schritten drehen und dann vergleichen.
Es ist nur die Frage ob du das für alle 3 Achsen machen musst oder immer nur eine Achse sich dreht.

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

In der Regel gibts es keine Regel... leider

Und es ist die Frage ob es reicht nur 2 Achsen zu verdrehen...

1.Körper in einer Achse um 90 gedreht....Als Drehachsen habe ich Bauteilkanten genommen...funkt nicht
2.Körper in allen Achsen um 90 gedreht....Als Drehachsen habe ich Bauteilkanten genommen....funkt
3.Körper um die Hauptachsen XYZ gedreht....funkt nicht
4.Körper um X-Hauptachse gedreht...funkt
5.Körper um Y-Hauptachse gedreht...funkt nicht

Zitat:

---

Original erstellt von roccat:
Ich würde trotzdem bei deiner Variante bleiben und nach dem AxsToAxs noch ein Rotate machen und immer in 90° schritten drehen und dann vergleichen.
Es ist nur die Frage ob du das für alle 3 Achsen machen musst oder immer nur eine Achse sich dreht.

mfG
Mario

---

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Ich meinte du machst von deim Body2 ein AxsToAxs vom Schwerpunkachsensystem2 aufs Schwerpunkachsensystem1.
Dann drehst du den Body2 um das Schwerpunktachsensystem1 jeweils 4x um X,Y,Z in 90° Schritten. Dazwischen immer vergleichen.
Ich gehe davon aus das zwei Achsen immer auf 0 bleiben können und nur eine Verdreht ist. (Es wird vermutlich aber nicht immer die gleiche sein...)

Alternativ kannst du die Drehung auch vor dem AxsToAxs machen, musst du dann halt ums Schwerpunkachsensystem2 drehen.

Allerdings musst du das Schwerpunktachsensystem ohne Link erzeugen oder mit einen ResultKörper arbeiten sonst modifizierst du dein Schwerpunktachsensystem und es kommt zu Fehlern.

mfG
Mario

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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

---

Servus

In den Bildern sieht es so aus, dass die X-Achse der ersten Hauptachse entspricht und die Y-Achse der Zweiten.
Bei beiden Achsen scheint es so zu sein dass diese auch invertiert sein können.
Damit sollten sich die möglichen Ausrichtungen (bzw erforderlichen Drehungen zum Vergleichen) einschränken lassen.

Gruß
Bernd

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

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

---

Guten Morgen Mario.

Danke. Ja so könnte es funktionieren.

Wie kann man vom z.B. "Achssystem.14/X-Achse" eine Referenz für die Drehachse erzeugen?

Im Moment erzeuge ich vom NullPunkt des Schwerpunktachsensystems1 mit der Richtung eine Linie
Diese Linie benutze ich als Drehachse....

'------------------------------------------------------------------
Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(AxisCoord(0), AxisCoord(1), AxisCoord(2))

dim line_1 as hybridshapelineptdir
set line_1=hybridShapeFactory1.addnewlinePtDir(originpoint,hybridShapeD1,0,50,true)

Dim reference1 As Reference
set reference1 = part1.CreateReferenceFromObject(line_1)
'------------------------------------------------------------------

geht es auch anders?

mfg
Dragan

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Guten Morgen,

hier mal eine Grundstruktur.

mfG
Mario

Code:

---

Option Explicit

Sub CATMain()

Dim MyDocument      As PartDocument
Dim MyPart          As Part

Dim MyAxis1        As AxisSystem
Dim MyAxis2        As AxisSystem

Dim MyBody1        As Body
Dim MyBody2        As Body

Dim MyReference1    As Reference
Dim MyReference2    As Reference

Dim MyHybBodies    As HybridBodies
Dim MyHybBody      As HybridBody
Dim MyFactory      As ShapeFactory

Dim MyRotateX      As Rotate
Dim MyRotateY      As Rotate
Dim MyRotateZ      As Rotate
Dim MyHybRotate    As HybridShapeRotate
Dim MyAxsToAxs      As AxisToAxis

Dim sIntName        As String

'Allgemein
Set MyDocument = CATIA.ActiveDocument
Set MyPart = MyDocument.Part
Set MyFactory = MyPart.ShapeFactory

'Bodies holen
Set MyBody1 = MyPart.MainBody
Set MyBody2 = MyPart.FindObjectByName("Body.4")

'Arbeits-GeoSet anlegen
Set MyHybBodies = MyPart.HybridBodies
Set MyHybBody = MyHybBodies.Add
MyHybBody.Name = "ANALYSE"

'COG-Achsen erzeugen
Set MyAxis1 = CreateCOGAxis(MyBody1)
Set MyAxis2 = CreateCOGAxis(MyBody2)

'Rotation erzeugen
MyPart.InWorkObject = MyBody2
sIntName = MyAxis2.GetItem("ModelElement").InternalName

'X-Achse
Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";1);None:();Cf11:());Face:(Brp:(" & sIntName & ";3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
Set MyRotateX = MyFactory.AddNewRotate2(MyReference1, 0#)

'Y-Achse
Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";2);None:();Cf11:());Face:(Brp:(" & sIntName & ";1);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
Set MyRotateY = MyFactory.AddNewRotate2(MyReference1, 0#)

'Z-Achse
Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";3);None:();Cf11:());Face:(Brp:(" & sIntName & ";2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
Set MyRotateZ = MyFactory.AddNewRotate2(MyReference1, 0#)

'AxsToAxs erzeugen
MyPart.InWorkObject = MyBody2
Set MyReference1 = MyPart.CreateReferenceFromObject(MyAxis2)
Set MyReference2 = MyPart.CreateReferenceFromObject(MyAxis1)
Set MyAxsToAxs = MyFactory.AddNewAxisToAxis2(MyReference1, MyReference2)
MyPart.UpdateObject MyBody2

End Sub

Function CreateCOGAxis(MyBody As Body) As AxisSystem

Dim MySelection        As Selection
Dim MyPart              As Part
Dim MyRef              As Reference
Dim MySPAWkb            As SPAWorkbench
Dim MyMeasurable        'As Measurable
Dim MyInertia          'As Inertia
Dim MyInertias          As Inertias

Dim MyAxiss            As AxisSystems
Dim MyAxis              'As AxisSystem

Dim MyCoord(2)
Dim MyVectors(8)
Dim MyXVector(2)
Dim MyYVector(2)
Dim MyZVector(2)

'Allgemein
Set MyPart = MyBody.Parent.Parent
Set MyRef = MyPart.CreateReferenceFromObject(MyBody)
Set MySPAWkb = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

'COG-Punkt
Set MyMeasurable = MySPAWkb.GetMeasurable(MyRef)
MyMeasurable.GetCOG MyCoord

'COG-Ausrichtung
Set MyInertias = MySPAWkb.Inertias
Set MyInertia = MyInertias.Add(MyBody)
MyInertia.GetPrincipalAxes MyVectors

'Achsensystem erzeugen
Set MyAxiss = MyPart.AxisSystems
Set MyAxis = MyAxiss.Add
MyAxis.PutOrigin MyCoord

'X-Achse
MyAxis.XAxisType = catAxisSystemAxisByCoordinates
MyXVector(0) = MyVectors(0)
MyXVector(1) = MyVectors(3)
MyXVector(2) = MyVectors(6)
MyAxis.PutXAxis MyXVector

'Y-Achse
MyAxis.YAxisType = catAxisSystemAxisByCoordinates
MyYVector(0) = MyVectors(1)
MyYVector(1) = MyVectors(4)
MyYVector(2) = MyVectors(7)
MyAxis.PutYAxis MyYVector

'Z-Achse
MyAxis.ZAxisType = catAxisSystemAxisByCoordinates
MyZVector(0) = MyVectors(2)
MyZVector(1) = MyVectors(5)
MyZVector(2) = MyVectors(8)
MyAxis.PutZAxis MyZVector

'Uebergeben
MyPart.UpdateObject MyAxis
Set CreateCOGAxis = MyAxis

End Function

---

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

[Diese Nachricht wurde von roccat am 30. Okt. 2020 editiert.]

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

---

Hallo Mario.

Vielen DANK, du bist der Beste!

Damit kann ich arbeiten...

Es funktioniert natürlich,ich muss es aber mal verarbeiten um "alles" zu verstehen.

Muss mir auch ein Konzept für meine Anwendung erstellen.

bei mir funktionerit 0# nicht...hab # entfernt
Set MyRotateX = MyFactory.AddNewRotate2(MyReference1, 0#)

mfg
Dragan

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

[Diese Nachricht wurde von BLD1983 am 30. Okt. 2020 editiert.]

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

---

Zitat:

---

Original erstellt von BLD1983:
Hallo Mario.

Vielen DANK, du bist der Beste!

Damit kann ich arbeiten...

Es funktioniert natürlich,ich muss es aber mal verarbeiten um "alles" zu verstehen.

Muss mir auch ein Konzept für meine Anwendung erstellen.

bei mir funktionerit 0# nicht...hab # entfernt
[b]Set MyRotateX = MyFactory.AddNewRotate2(MyReference1, 0#)

PS: Du hast eine PM erhalten.;)

mfg
Dragan

[/B]

---

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Servus

Als weiter Idee zu den Drehungen: du könntest auch das Achsensystem (das Quellsystem der AxisToAxis-Transformation) entsprechend anpassen (zB PutVectors, PutXAxis, PutYAxis).

Gruß
Bernd

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

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

---

Servus Bernd.

Zuerst dachte ich es hat keinen Sinn das QuellAchssystem zu verändern weil es bei der Transformation nicht mitgeht.
Jedoch hat die Funktion AxisToAxis eine Verknüpfung mit den QuellAchssystem und die Orientierung des Bauteils verändert sich.

Danke, es ist natürlich eine Option aber ich glaube die Anzahl der Anpassungen und Prüfschleifen bleibt gleich oder?

Mit freundlichen Grüßen
Dragan

------------------
Ich will es gar nicht wissen, aber ich muss.....Das Leben verlangt es.

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

---

Servus

Ich vermute dass dir folgen Prüfschleifen reichen:

• ohne Transformation
  
• X invertiert
  
• Y invertiert
  
• X wieder zurück invertieren

Gruß
Bernd

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

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

---

KoerperVergleich.zip

Hallo,

Anbei noch eine Erweitung...

Prüfung erfolgt aktuell nur über das Volumen, kann aber noch auf Flächen und Trägheitsmoment erweitert werden.

mfG
Mario

Code:

---

Option Explicit

Sub CATMain()

Dim MyDocument      As PartDocument
Dim MyPart          As Part
Dim MySelection     As Selection

Dim MyAxis1         As AxisSystem
Dim MyAxis2         As AxisSystem

Dim MyBodies        As Bodies
Dim MyBody()        As Body
Dim MyBody1         As Body
Dim MyBody2         As Body

Dim MyReference1    As Reference
Dim MyReference2    As Reference

Dim MyHybBodies     As HybridBodies
Dim MyHybBody       As HybridBody
Dim MyFactory       As ShapeFactory

Dim MyRotateX       As Rotate
Dim MyRotateY       As Rotate
Dim MyRotateZ       As Rotate
Dim MyHybRotate     As HybridShapeRotate
Dim MyAxsToAxs      'As AxisToAxis
Dim MyAdd           As Add

Dim sIntName        As String
Dim sName           As String
Dim i               As Integer
Dim c               As Integer
Dim X               As Integer
Dim Y               As Integer
Dim Z               As Integer
Dim IsSamePart      As Boolean

Dim Vol1            As Double
Dim Vol2            As Double

'SuchVariable
sName = "STAHLTEILE"

'Allgemein
Set MyDocument = CATIA.ActiveDocument
Set MySelection = MyDocument.Selection
Set MyPart = MyDocument.Part
Set MyBodies = MyPart.Bodies
Set MyFactory = MyPart.ShapeFactory

'Bodies suchen / holen
i = -1
For Each MyBody1 In MyBodies
    If InStr(1, MyBody1.Name, sName) <> 0 And MyBody1.InBooleanOperation = False Then
        i = i + 1
        ReDim Preserve MyBody(i)
        MyBody1.Name = sName & "_" & i
        Set MyBody(i) = MyBody1
       
    End If
Next

'Schleife über alle Bodies / als Ausgangsbody
For i = 0 To UBound(MyBody)
   
    Set MyBody1 = MyBody(i)
    'Prüfung ob schon umbenannt wurde
    If Left(MyBody1.Name, 2) <> "GT" And Left(MyBody1.Name, 4) <> "GESP" Then

        'Volumen vom Ausgangsbody
        Vol1 = GetVol(MyBody1)
       
        'Schleife über alle Bodies / als Vergleichtsbody
        For c = i + 1 To UBound(MyBody)
           
            Set MyBody2 = MyBody(c)
            Vol2 = GetVol(MyBody2)
           
            'Prüfung gleiches Volumen
            If Vol1 = Vol2 Then
               
                'Arbeits-GeoSet anlegen
                Set MyHybBodies = MyPart.HybridBodies
                Set MyHybBody = MyHybBodies.Add
                MyHybBody.Name = "ANALYSE"
               
                'COG-Achsen erzeugen
                Set MyAxis1 = CreateCOGAxis(MyBody1)
                Set MyAxis2 = CreateCOGAxis(MyBody2)
               
               
                'Rotation erzeugen
                MyPart.InWorkObject = MyBody2
                sIntName = MyAxis2.GetItem("ModelElement").InternalName
               
                'X-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";1);None:();Cf11:());Face:(Brp:(" & sIntName & ";3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateX = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'Y-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";2);None:();Cf11:());Face:(Brp:(" & sIntName & ";1);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateY = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'Z-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";3);None:();Cf11:());Face:(Brp:(" & sIntName & ";2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateZ = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'AxsToAxs erzeugen
                MyPart.InWorkObject = MyBody2
                Set MyReference1 = MyPart.CreateReferenceFromObject(MyAxis2)
                Set MyReference2 = MyPart.CreateReferenceFromObject(MyAxis1)
                Set MyAxsToAxs = MyFactory.AddNewAxisToAxis2(MyReference1, MyReference2)
                Set MyAxsToAxs = MyBody2.Shapes.Item(MyBody2.Shapes.Count)
                MyPart.UpdateObject MyBody2
               
                'ADD erzeugen
                MyPart.InWorkObject = MyBody1
                Set MyAdd = MyFactory.AddNewAdd(MyBody2)
               
                'Drehung
                IsSamePart = False
                For X = 0 To 180 Step 180
                    MyRotateX.AngleValue = X
                   
                    For Y = 0 To 180 Step 180
                    MyRotateY.AngleValue = Y
                   
                        For Z = 0 To 180 Step 180
                        MyRotateZ.AngleValue = Z
                           
                            'Prüfung
                            MyPart.UpdateObject MyBody1
                            If Vol1 = GetVol(MyBody1) Then
                                IsSamePart = True
                                GoTo ExitFor
                            End If
                           
                        Next
                    Next
                Next
               
ExitFor:
               
                'Auswertung
                If IsSamePart = True Then
                    MyBody2.Name = "GT_zu_" & MyBody1.Name
                ElseIf IsSamePart = False Then
                    MyBody2.Name = "GESP_zu_" & MyBody1.Name
                End If
               
                'Alles löschen
                MySelection.Clear
                MySelection.Add MyHybBody
                MySelection.Add MyRotateX
                MySelection.Add MyRotateY
                MySelection.Add MyRotateZ
                MySelection.Add MyAxsToAxs
                MySelection.Add MyAdd
                MySelection.Delete
                MyPart.UpdateObject MyBody1
                MyPart.UpdateObject MyBody2
               
            End If
           
        Next
    End If
Next

End Sub

Function CreateCOGAxis(MyBody As Body) As AxisSystem

Dim MySelection         As Selection
Dim MyPart              As Part
Dim MyRef               As Reference
Dim MySPAWkb            As SPAWorkbench
Dim MyMeasurable        'As Measurable
Dim MyInertia           'As Inertia
Dim MyInertias          As Inertias

Dim MyAxiss             As AxisSystems
Dim MyAxis              'As AxisSystem

Dim MyCoord(2)
Dim MyVectors(8)
Dim MyXVector(2)
Dim MyYVector(2)
Dim MyZVector(2)

'Allgemein
Set MyPart = MyBody.Parent.Parent
Set MyRef = MyPart.CreateReferenceFromObject(MyBody)
Set MySPAWkb = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

'COG-Punkt
Set MyMeasurable = MySPAWkb.GetMeasurable(MyRef)
MyMeasurable.GetCOG MyCoord

'COG-Ausrichtung
Set MyInertias = MySPAWkb.Inertias
Set MyInertia = MyInertias.Add(MyBody)
MyInertia.GetPrincipalAxes MyVectors

'Achsensystem erzeugen
Set MyAxiss = MyPart.AxisSystems
Set MyAxis = MyAxiss.Add
MyAxis.PutOrigin MyCoord

'X-Achse
MyAxis.XAxisType = catAxisSystemAxisByCoordinates
MyXVector(0) = MyVectors(0)
MyXVector(1) = MyVectors(3)
MyXVector(2) = MyVectors(6)
MyAxis.PutXAxis MyXVector

'Y-Achse
MyAxis.YAxisType = catAxisSystemAxisByCoordinates
MyYVector(0) = MyVectors(1)
MyYVector(1) = MyVectors(4)
MyYVector(2) = MyVectors(7)
MyAxis.PutYAxis MyYVector

'Z-Achse
MyAxis.ZAxisType = catAxisSystemAxisByCoordinates
MyZVector(0) = MyVectors(2)
MyZVector(1) = MyVectors(5)
MyZVector(2) = MyVectors(8)
MyAxis.PutZAxis MyZVector

'Uebergeben
MyPart.UpdateObject MyAxis
Set CreateCOGAxis = MyAxis

End Function

Function GetVol(MyBody As Body) As Double

Dim MyDocument          As Document
Dim TheSPAWorkbench     As SPAWorkbench
Dim TheMeasurable       As Measurable
Dim Message             As String
Dim Distance            As Double
Dim MyPart              As Part
Dim MyReference1        As Reference
   
Set MyDocument = MyBody.Parent.Parent.Parent
Set TheSPAWorkbench = MyDocument.GetWorkbench("SPAWorkbench")
Set MyPart = MyDocument.Part
Set MyReference1 = MyPart.CreateReferenceFromObject(MyBody)

'Messe Volumen
If Not MyBody Is Nothing Then
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(MyReference1)
    GetVol = Round(TheMeasurable.Volume, 10)
End If

End Function

---

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

[Diese Nachricht wurde von roccat am 02. Nov. 2020 editiert.]

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

---

KoerperVergleich.zip

Folgende Punkte sind noch drin...

-Inputbox zur Auswahl welche Teile bearbeitet werden sollen (Stahlteile, Aluteile...)
-Wenn zwei verechnete Gleichteile ein Updatefehler erzeugen, wird ein Teil davon in sehr kleinen Schritten Skaliert bis das Update funktioniert. Danach wird die Prüfung durchgeführt. Und ein Hinweis an die Bodybenennung angefügt. (bsp.: "GESP_zu_ALUTEIL_2  !!! SCALE = 0,9999 !!!")
-Die Prüfung auf Fläche und Trägheitsmomente erweitert. (Volumen und Fläche werden auf 5 Stellen und die Summe Trägheitsmomente auf 15 Stellen nach dem Komma gerundet)

mfG
Mario

Code:

---

Option Explicit

Sub CATMain()

Dim MyDocument      As PartDocument
Dim MyPart          As Part
Dim MySelection    As Selection

Dim MyAxis1        As AxisSystem
Dim MyAxis2        As AxisSystem

Dim MyBodies        As Bodies
Dim MyBody()        As Body
Dim MyBody1        As Body
Dim MyBody2        As Body

Dim MyReference1    As Reference
Dim MyReference2    As Reference

Dim MyHybBodies    As HybridBodies
Dim MyHybBody      As HybridBody
Dim MyFactory      As ShapeFactory

Dim MyRotateX      As Rotate
Dim MyRotateY      As Rotate
Dim MyRotateZ      As Rotate
Dim MyHybRotate    As HybridShapeRotate
Dim MyAxsToAxs      'As AxisToAxis
Dim MyScaling      As Scaling2
Dim MyAdd          As Add

Dim sIntName        As String
Dim sName          As String
Dim sErr            As String
Dim i              As Integer
Dim c              As Integer
Dim X              As Integer
Dim Y              As Integer
Dim Z              As Integer
Dim IsSamePart      As Boolean

Dim Vol1            As Double
Dim Vol2            As Double

Dim Area1          As Double
Dim Area2          As Double

Dim FTM1            As Double
Dim FTM2            As Double

'SuchVariable
sName = "STAHLTEIL"

sName = InputBox("Welche Körper sollen verglichen werden?", "Körper vergleichen", sName)
If sName = "" Then
    Exit Sub
End If

'Allgemein
Set MyDocument = CATIA.ActiveDocument
Set MySelection = MyDocument.Selection
Set MyPart = MyDocument.Part
Set MyBodies = MyPart.Bodies
Set MyFactory = MyPart.ShapeFactory

'Bodies suchen / holen
i = -1
For Each MyBody1 In MyBodies
    If InStr(1, MyBody1.Name, sName) <> 0 And MyBody1.InBooleanOperation = False Then
        i = i + 1
        ReDim Preserve MyBody(i)
        MyBody1.Name = sName & "_" & i
        Set MyBody(i) = MyBody1
       
    End If
Next

'Schleife über alle Bodies / als Ausgangsbody
For i = 0 To UBound(MyBody)
    sErr = ""
    Set MyBody1 = MyBody(i)
    Debug.Print "----------------------------------------------------------------------------"
     
    'Prüfung ob schon umbenannt wurde
    If Left(MyBody1.Name, 2) <> "GT" And Left(MyBody1.Name, 4) <> "GESP" Then

        'Ausgangsbody messen
        Vol1 = GetVol(MyBody1)
        Area1 = GetArea(MyBody1)
        FTM1 = GetPrincipalMoments(MyBody1)
       
        'Schleife über alle Bodies / als Vergleichtsbody
        For c = i + 1 To UBound(MyBody)
           
            Set MyBody2 = MyBody(c)
            Vol2 = GetVol(MyBody2)
            Area2 = GetArea(MyBody2)
            FTM2 = GetPrincipalMoments(MyBody2)
           
            'Prüfung gleiches Volumen
            If Vol1 = Vol2 And Area1 = Area2 And FTM1 = FTM2 Then
               
                'Arbeits-GeoSet anlegen
                Set MyHybBodies = MyPart.HybridBodies
                Set MyHybBody = MyHybBodies.Add
                MyHybBody.Name = "ANALYSE"
               
                'COG-Achsen erzeugen
                Set MyAxis1 = CreateCOGAxis(MyBody1)
                Set MyAxis2 = CreateCOGAxis(MyBody2)
               
                'Skalierung erzeugen
                MyPart.InWorkObject = MyBody2
                sIntName = MyAxis2.GetItem("ModelElement").InternalName
               
                'Skalierung erzeugen
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("FVertex:(Vertex:(Neighbours:(Face:(Brp:(" & sIntName & ";2);None:();Cf11:());Face:(Brp:(" & sIntName & ";3);None:();Cf11:());Face:(Brp:(" & sIntName & ";1);None:();Cf11:()));Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyScaling = MyFactory.AddNewScaling2(MyReference1, 1)
               
                'Rotation erzeugen
                'X-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";1);None:();Cf11:());Face:(Brp:(" & sIntName & ";3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateX = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'Y-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";2);None:();Cf11:());Face:(Brp:(" & sIntName & ";1);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateY = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'Z-Achse
                Set MyReference1 = MyPart.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(" & sIntName & ";3);None:();Cf11:());Face:(Brp:(" & sIntName & ";2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", MyAxis2)
                Set MyRotateZ = MyFactory.AddNewRotate2(MyReference1, 0#)
               
                'AxsToAxs erzeugen
                MyPart.InWorkObject = MyBody2
                Set MyReference1 = MyPart.CreateReferenceFromObject(MyAxis2)
                Set MyReference2 = MyPart.CreateReferenceFromObject(MyAxis1)
                Set MyAxsToAxs = MyFactory.AddNewAxisToAxis2(MyReference1, MyReference2)
                Set MyAxsToAxs = MyBody2.Shapes.Item(MyBody2.Shapes.Count)
               

               
                MyPart.UpdateObject MyBody2
               
                'ADD erzeugen
                MyPart.InWorkObject = MyBody1
                Set MyAdd = MyFactory.AddNewAdd(MyBody2)
               
                'Drehung
                IsSamePart = False
                For X = 0 To 180 Step 180
                    MyRotateX.AngleValue = X
                   
                    For Y = 0 To 180 Step 180
                    MyRotateY.AngleValue = Y
                   
                        For Z = 0 To 180 Step 180
                        MyRotateZ.AngleValue = Z
                           
                            'Update - bei Fehler Body2 minimal Skalieren bis Update funktioniert
                            Do
                                Err.Clear
                                On Error Resume Next
                                MyPart.UpdateObject MyBody1
                               
                                If Err.Number <> 0 Then
                                    On Error GoTo 0
                                    MyScaling.RatioValue = MyScaling.RatioValue - 0.0001
                                    sErr = "  !!! SCALE = " & MyScaling.RatioValue & " !!!"
                                Else
                                    On Error GoTo 0
                                    Exit Do
                                End If
                            Loop
                           
                            'Prüfung
                            If Vol1 = GetVol(MyBody1) And Area1 = GetArea(MyBody1) And FTM1 = GetPrincipalMoments(MyBody1) Then
                                IsSamePart = True
                                GoTo ExitFor
                            End If
                           
                        Next
                    Next
                Next
               
ExitFor:
               
                'Auswertung
                If IsSamePart = True Then
                    MyBody2.Name = "GT_zu_" & MyBody1.Name & sErr
                ElseIf IsSamePart = False Then
                    MyBody2.Name = "GESP_zu_" & MyBody1.Name & sErr
                End If
               
                'Alles löschen
                MySelection.Clear
                MySelection.Add MyHybBody
                MySelection.Add MyScaling
                MySelection.Add MyRotateX
                MySelection.Add MyRotateY
                MySelection.Add MyRotateZ
                MySelection.Add MyAxsToAxs
                MySelection.Add MyAdd
                MySelection.Delete
                MyPart.UpdateObject MyBody1
                MyPart.UpdateObject MyBody2
               
            End If
           
        Next
    End If
Next

CATIA.StatusBar = "Bearbeitung abgeschlossen."

End Sub

Function CreateCOGAxis(MyBody As Body) As AxisSystem

Dim MySelection        As Selection
Dim MyPart              As Part
Dim MyRef              As Reference
Dim MySPAWkb            As SPAWorkbench
Dim MyMeasurable        'As Measurable
Dim MyInertia          'As Inertia
Dim MyInertias          As Inertias

Dim MyAxiss            As AxisSystems
Dim MyAxis              'As AxisSystem

Dim MyCoord(2)
Dim MyVectors(8)
Dim MyXVector(2)
Dim MyYVector(2)
Dim MyZVector(2)

'Allgemein
Set MyPart = MyBody.Parent.Parent
Set MyRef = MyPart.CreateReferenceFromObject(MyBody)
Set MySPAWkb = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

'COG-Punkt
Set MyMeasurable = MySPAWkb.GetMeasurable(MyRef)
MyMeasurable.GetCOG MyCoord

'COG-Ausrichtung
Set MyInertias = MySPAWkb.Inertias
Set MyInertia = MyInertias.Add(MyBody)
MyInertia.GetPrincipalAxes MyVectors

'Achsensystem erzeugen
Set MyAxiss = MyPart.AxisSystems
Set MyAxis = MyAxiss.Add
MyAxis.PutOrigin MyCoord

'X-Achse
MyAxis.XAxisType = catAxisSystemAxisByCoordinates
MyXVector(0) = MyVectors(0)
MyXVector(1) = MyVectors(3)
MyXVector(2) = MyVectors(6)
MyAxis.PutXAxis MyXVector

'Y-Achse
MyAxis.YAxisType = catAxisSystemAxisByCoordinates
MyYVector(0) = MyVectors(1)
MyYVector(1) = MyVectors(4)
MyYVector(2) = MyVectors(7)
MyAxis.PutYAxis MyYVector

'Z-Achse
MyAxis.ZAxisType = catAxisSystemAxisByCoordinates
MyZVector(0) = MyVectors(2)
MyZVector(1) = MyVectors(5)
MyZVector(2) = MyVectors(8)
MyAxis.PutZAxis MyZVector

'Uebergeben
MyPart.UpdateObject MyAxis
Set CreateCOGAxis = MyAxis

End Function

Function GetVol(MyBody As Body) As Double

Dim MyDocument          As Document
Dim TheSPAWorkbench    As SPAWorkbench
Dim TheMeasurable      As Measurable
Dim Message            As String
Dim Distance            As Double
Dim MyPart              As Part
Dim MyReference1        As Reference
   
Set MyDocument = MyBody.Parent.Parent.Parent
Set TheSPAWorkbench = MyDocument.GetWorkbench("SPAWorkbench")
Set MyPart = MyDocument.Part
Set MyReference1 = MyPart.CreateReferenceFromObject(MyBody)

If Not MyBody Is Nothing Then
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(MyReference1)
    GetVol = Round(TheMeasurable.Volume, 5)
End If

End Function

Function GetArea(MyBody As Body) As Double

Dim MyDocument          As Document
Dim TheSPAWorkbench    As SPAWorkbench
Dim TheMeasurable      As Measurable
Dim Message            As String
Dim Distance            As Double
Dim MyPart              As Part
Dim MyReference1        As Reference
   
Set MyDocument = MyBody.Parent.Parent.Parent
Set TheSPAWorkbench = MyDocument.GetWorkbench("SPAWorkbench")
Set MyPart = MyDocument.Part
Set MyReference1 = MyPart.CreateReferenceFromObject(MyBody)

If Not MyBody Is Nothing Then
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(MyReference1)
    GetArea = Round(TheMeasurable.Area, 5)
End If

End Function

Function GetPrincipalMoments(MyBody As Body) As Double

Dim MyDocument          As Document
Dim TheSPAWorkbench    As SPAWorkbench
Dim MyInertia          'As Inertia
Dim FTM(2)

Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

If Not MyBody Is Nothing Then
    Set MyInertia = TheSPAWorkbench.Inertias.Add(MyBody)
    MyInertia.Density = 1
    MyInertia.GetPrincipalMoments FTM
    GetPrincipalMoments = Round(FTM(0) + FTM(1) + FTM(2), 15)
End If

End Function

---

------------------
Wenn das die Lösung sein soll,
will ich mein Problem zurück !!

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