---

Moin Leute,

ich habe mal ein Makro reingepackt, welches die Funktion "Produkte vergleichen" von CATIA automatisiert. Sprich, es müssen lediglich vom Anwender die Dateien ausgewählt werden und CATIA berechnet dann den Rest, einschließlich der Ausgabe im Fenster zum Schluss.

Allerdings sollen nur die Volumenänderungen bezogen auf die Außengeometrie ausgegeben werden. Bis jetzt gibt das Makro allerdings die gesamten Änderungen aus. Also auch die Änderungen der Innengeometrie. Hätte jemand vielleicht eine Idee wie man die Volumenänderung bezogen auf die Außengeometrie realisieren kann?

Mir fehlt es an Fachwissen um CATIA automatisiert erkennen zu lassen, was die Außengeometrie bei jeder Datei ist.

Und entschuldigt, dass das Makro so lang ist. Man könnte es bestimmt effizienter gestallten, aber ich bin noch neu im Gebiet. 

Code:

---

Sub CATMain()

'Prüfen ob noch Dateien geöffnet sind
On Error Resume Next

Set testdoc = CATIA.ActiveDocument

    If Err.Number = 0 Then
      MsgBox "Schließen Sie bitte zuerst alle offenen Dateien", 16, makroname + " " + Version
      Exit Sub
     
    Else
      Err.Clear
     
    End If

'Neues Produkt erzeugen
Dim documents1 As Documents
Set documents1 = CATIA.Documents

Dim productDocument1 As ProductDocument
Set productDocument1 = documents1.Add("Product")

Dim product1 As Product
Set product1 = productDocument1.Product

Dim products1 As Products
Set products1 = product1.Products

'Daten in das Produkt einbinden
Dim partfile1, partfile2
partfile1 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.CATPart;*.cgr;*.model", CatFileSelectionModeOpen)
             
        If partfile1 <> "" Then
            Set PP = CATIA.ActiveDocument.Product.Products
            Dim Liste1(0)
            Liste1(0) = partfile1
            PP.AddComponentsFromFiles Liste1, "All"
               
        Else
            MsgBox "Makro wurde abgebrochen", 16, makroname + " " + Version
            Exit Sub
               
        End If
             
partfile2 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil2", "*.CATPart;*.cgr;*.model", CatFileSelectionModeOpen)
             
        If partfile2 <> "" Then
            Set PP = products1
            Dim Liste2(0)
            Liste2(0) = partfile2
            PP.AddComponentsFromFiles Liste2, "All"
               
        Else
            MsgBox "Makro wurde abgebrochen", 16, makroname + " " + Version
            Exit Sub
               
        End If

Dim added As Double
Dim removed As Double

'Produkte vergleichen
Dim optimizerWorkBench1 As Workbench
Set optimizerWorkBench1 = productDocument1.GetWorkbench("OptimizerWorkBench")

'Zu vergleichende Produkte
Dim product2 As Product
Set product2 = products1.Item(1)
Dim product3 As Product
Set product3 = products1.Item(2)

'Vergleich
Dim partComps1 As PartComps
Set partComps1 = optimizerWorkBench1.PartComps
Dim partComp1 As PartComp

'Parameter :
'product2 : Erstes Produkt (alte Version)
'product3 : Zweites Produkt (neue Version)
'2.000000 : Berechnungs Genauigkeit (mm)
'2.000000 : Anzeigegenauigkeit (mm)
'2 : Berechnungstyp : 0=hinzugefügt, 1=enfternt, 2=hinzugefügt&enfernt

Dim Box
Box = MsgBox("Die Berechnungsgenauigkeit und die Anzeigegenauigkeit beeträgt 1mm." & Chr(13) & "Standardwerte ändern?", 3, "Standardwerte")

Select Case Box

Case "6"

Dim BGenauigkeit
    BGenauigkeit = "2"
    BGenauigkeit = InputBox("Geben Sie die Genauigkeit der Berechnung in Millimetern ein.", "Berechnungsgenauigkeit", Eingabe)
   
    Dim AGenauigkeit
    AGenauigkeit = "2"
    AGenauigkeit = InputBox("Geben Sie die Genauigkeit der Anzeige in Millimetern ein.", "Anzeigegenauigkeit", Anzeige)
   
    Set partComp1 = partComps1.Add(product2, product3, BGenauigkeit, AGenauigkeit, 2)

    'Abrufen des hinzugefügten Volumen (%, Wärte zwischen 0.0 und 1.0)
    Dim PercentAdded As Double
    PercentAdded = partComps1.AddedMaterialPercentage

    'Abrufen des entfernten Volumens (%, Wärte zwischen 0.0 und 1.0)
    Dim PercentRemoved As Double
    PercentRemoved = partComps1.RemovedMaterialPercentage
   
    If PercentAdded > MinDiff And PercentRemoved > MinDiff Then
   
        MsgBox ("Eine Geometrieänderung durch hinzugefügtes und entferntes Volumen liegt vor.")
       
    ' Speichern beider Daten
    Dim document1 As Document
    Set document1 = documents1.Item("AddedMaterial.3dmap")
    document1.Activate

    Dim sPathAddDocument1 As String
    sPathAddDocument1 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
    document1.SaveAs sPathAddDocument1
   
    Dim document2 As Document
    Set document2 = documents1.Item("RemovedMaterial.3dmap")
    document2.Activate

    Dim sPathAddDocument2 As String
    sPathAddDocument2 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
    document2.SaveAs sPathAddDocument2
   
    document2.Close
    document1.Close
   
    'Import des hinzugefügten und entfernten Materials
    Dim sFileList1(0)
    sFileList1(0) = sPathAddDocument1
    PP.AddComponentsFromFiles sFileList1, "All"

    Dim sFileList2(0)
    sFileList2(0) = sPathAddDocument2
    PP.AddComponentsFromFiles sFileList2, "All"
   
    'Ausrichten
    CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
    CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
    CATIA.ActiveWindow.ActiveViewer.Reframe
    CATIA.ActiveWindow.ActiveViewer.ZoomIn
    CATIA.ActiveWindow.ActiveViewer.ZoomIn
   
    Else
        If PercentAdded > MinDiff Then
           
            MsgBox ("Eine Geometrieänderung durch hinzugefügtes Volumen liegt vor.")
           
            'Speichern hinzugefügtes Material
            Dim document3 As Document
            Set document3 = documents1.Item("AddedMaterial.3dmap")
            document3.Activate
       
            Dim sPathAddDocument3 As String
            sPathAddDocument3 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
            document3.SaveAs sPathAddDocument3
            document3.Close
           
            'Import des hinzugefügten Materials
            Dim sFileList3(0)
            sFileList3(0) = sPathAddDocument3
            PP.AddComponentsFromFiles sFileList3, "All"
   
            ' Ausrichten
            CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
            CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
            CATIA.ActiveWindow.ActiveViewer.Reframe
            CATIA.ActiveWindow.ActiveViewer.ZoomIn
            CATIA.ActiveWindow.ActiveViewer.ZoomIn
   
        Else
            If PercentRemoved > MinDiff Then
           
                MsgBox ("Eine Geometrieänderung durch entferntes Volumen liegt vor.")
               
                Dim document4 As Document
                Set document4 = documents1.Item("RemovedMaterial.3dmap")
                document4.Activate
           
                Dim sPathAddDocument4 As String
                sPathAddDocument4 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
                document4.SaveAs sPathAddDocument4
                document4.Close
           
                'Hinzufügen von entferntem Material
                Dim sFileList4(0)
                sFileList4(0) = sPathAddDocument4
                PP.AddComponentsFromFiles sFileList4, "All"
               
                'Ausrichten
                CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
                CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
                CATIA.ActiveWindow.ActiveViewer.Reframe
                CATIA.ActiveWindow.ActiveViewer.ZoomIn
                CATIA.ActiveWindow.ActiveViewer.ZoomIn
           
            Else
                MsgBox ("Keine Geometrieänderung")
                Exit Sub
            End If
        End If
    End If
   
Case "7"
   
    Set partComp1 = partComps1.Add(product2, product3, 1#, 1#, 2)

    'Abrufen des hinzugefügten Volumen (%, Wärte zwischen 0.0 und 1.0)
    Dim PercentAdded2 As Double
    PercentAdded2 = partComps1.AddedMaterialPercentage

    'Abrufen des entfernten Volumens (%, Wärte zwischen 0.0 und 1.0)
    Dim PercentRemoved2 As Double
    PercentRemoved2 = partComps1.RemovedMaterialPercentage
   
    If PercentAdded > MinDiff And PercentRemoved > MinDiff Then
   
        MsgBox ("Eine Geometrieänderung durch hinzugefügtes und entferntes Volumen liegt vor.")
       
    ' Speichern beider Daten
    Dim document12 As Document
    Set document12 = documents1.Item("AddedMaterial.3dmap")
    document12.Activate

    Dim sPathAddDocument12 As String
    sPathAddDocument12 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
    document12.SaveAs sPathAddDocument12
   
    Dim document22 As Document
    Set document22 = documents1.Item("RemovedMaterial.3dmap")
    document22.Activate

    Dim sPathAddDocument22 As String
    sPathAddDocument22 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
    document22.SaveAs sPathAddDocument22
   
    document22.Close
    document12.Close
   
    'Import des hinzugefügten und entfernten Materials
    Dim sFileList12(0)
    sFileList12(0) = sPathAddDocument12
    PP.AddComponentsFromFiles sFileList12, "All"

    Dim sFileList22(0)
    sFileList22(0) = sPathAddDocument22
    PP.AddComponentsFromFiles sFileList22, "All"
   
    'Ausrichten
    CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
    CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
    CATIA.ActiveWindow.ActiveViewer.Reframe
    CATIA.ActiveWindow.ActiveViewer.ZoomIn
    CATIA.ActiveWindow.ActiveViewer.ZoomIn
   
    Else
        If PercentAdded > MinDiff Then
           
            MsgBox ("Eine Geometrieänderung durch hinzugefügtes Volumen liegt vor.")
           
            'Speichern hinzugefügtes Material
            Dim document32 As Document
            Set document32 = documents1.Item("AddedMaterial.3dmap")
            document32.Activate
       
            Dim sPathAddDocument32 As String
            sPathAddDocument32 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
            document32.SaveAs sPathAddDocument32
            document32.Close
           
            'Import des hinzugefügten Materials
            Dim sFileList32(0)
            sFileList32(0) = sPathAddDocument32
            PP.AddComponentsFromFiles sFileList32, "All"
   
            ' Ausrichten
            CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
            CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
            CATIA.ActiveWindow.ActiveViewer.Reframe
            CATIA.ActiveWindow.ActiveViewer.ZoomIn
            CATIA.ActiveWindow.ActiveViewer.ZoomIn
   
        Else
            If PercentRemoved > MinDiff Then
           
                MsgBox ("Eine Geometrieänderung durch entferntes Volumen liegt vor.")
               
                Dim document42 As Document
                Set document42 = documents1.Item("RemovedMaterial.3dmap")
                document42.Activate
           
                Dim sPathAddDocument42 As String
                sPathAddDocument42 = CATIA.FileSelectionBox(makroname + " " + Version + " - Bauteil1", "*.3dmap", CatFileSelectionModeSave)
                document42.SaveAs sPathAddDocument42
                document42.Close
           
                'Hinzufügen von entferntem Material
                Dim sFileList42(0)
                sFileList42(0) = sPathAddDocument42
                PP.AddComponentsFromFiles sFileList42, "All"
               
                'Ausrichten
                CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutSightDirection Array(1#, 1, 0)
                CATIA.ActiveWindow.ActiveViewer.Viewpoint3D.PutUpDirection Array(0, 0, 1)
                CATIA.ActiveWindow.ActiveViewer.Reframe
                CATIA.ActiveWindow.ActiveViewer.ZoomIn
                CATIA.ActiveWindow.ActiveViewer.ZoomIn
           
            Else
                MsgBox ("Keine Geometrieänderung")
                Exit Sub
            End If
        End If
    End If

Case "2"
   
    MsgBox ("Das Makro wurde abgebrochen.")
    Exit Sub
   
End Select

End Sub

---

Gruß Max

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

---

Servus

Falls du die DMU Optimizer Lizenz hast, könntest du vor dem Vergleich eine Umhüllung (Wrapping) erzeugen und diese dann vergleichen.

Gruß
Bernd

PS: Die Fehlerbehandlung in deinen Code komplett auszuschalten ist aber "mutig"

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

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

---

Danke Bernd, war eine super Idee!

Ich habe nun versucht auch die Wrapping Funktion zu automatisieren. Habe mir die wichtigsten Code Zeilen aus dem Makrorecorder geholt.
Allerdings funktioniert der Code nicht mehr, wenn ich ihn umschreibe, so dass er mit beliebigen Geometrien arbeiten kann und nicht nur mit einer wie beim Makrorecorder.

Code:

---

Sub CATMain()

Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim groups1 As CATBaseDispatch
Set groups1 = product1.GetTechnologicalObject("Groups")

Dim group1 As Group
Set group1 = groups1.Add()

Dim products1 As Products
Set products1 = product1.Products

Dim product2 As Product
Set product2 = products1.Item("Quader.1")

group1.AddExplicit product2

Dim wrappings1 As CATBaseDispatch
Set wrappings1 = product1.GetTechnologicalObject("Wrappings")

Dim document1 As Document
Set document1 = wrappings1.ComputeAWrapping(group1, 1#, 0.01, 0#)

Dim optimizerWorkBench1 As Workbench
Set optimizerWorkBench1 = productDocument1.GetWorkbench("OptimizerWorkBench")

Dim long1 As Long
long1 = group1.CountExplicit()

group1.RemoveExplicit 1

groups1.Remove group1

document1.Activate

End Sub

---

CATIA arbeitet zwar, allerdings erscheint keine Wrapping-Datei in meinem geöffneten Produkt. Habt ihr eine Idee wodran das liegen könnte?

Code:

---

Dim groups1 As CATBaseDispatch
Set groups1 = product1.GetTechnologicalObject("Groups")

Dim group1 As Group
Set group1 = groups1.Add()

Dim product4 As Product
Set product4 = products1.Item(1)

group1.AddExplicit product4

Dim wrappings1 As CATBaseDispatch
Set wrappings1 = product1.GetTechnologicalObject("Wrappings")

Dim document1 As Document
Set document1 = wrappings1.ComputeAWrapping(group1, 1#, 0.01, 0#)

Dim optimizerWorkBench1 As Workbench
Set optimizerWorkBench1 = productDocument1.GetWorkbench("OptimizerWorkBench")

Dim long1 As Long
long1 = group1.CountExplicit()

group1.RemoveExplicit 1

groups1.Remove group1

document1.Activate

---

Ich habe es auch nochmal auf die gleiche Art und Weise probiert, wie ich es mit "Produkte vergleichen" gemacht habe, allerdings funktioniert das auch nicht 
Es kommt keine Fehlermeldung, CATIA arbeitet, aber wieder keine Ergebnisdatei.

Gruß Max

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

---

Servus

Schon mal versucht das document1 mit SaveAs abzuspeichern (Dateiendung cgr?)?

Gruß
Bernd

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

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

---

Moin Bernd,

ich habe es jetzt versucht, aber CATIA "macht" trotzdem nichts...
Es scheint so, dass CATIA die Funktion Wrapping zwar erkennt, aber nicht ausführt.
Habe ich vielleicht die falsche Workbench aufgerufen? Ich habe es genauso gemacht, wie bei der Funktion Produkte Vergleichen.

Code:

---

Dim product4 As Product
Set product4 = products1.Item(2)

Dim optimizerWorkBench1 As Workbench
Set optimizerWorkBench1 = productDocument1.GetWorkbench("OptimizerWorkBench")

Dim wrappings1 As Wrappings
Set wrappings1 = optimizerWorkBench1.Wrappings
Dim wrapping1 As Wrapping

Set wrapping1 = wrappings1.ComputeAWrapping(product4, 1#, 0.01, 0#)

wrapping1 = CATIA.FileSelectionBox("Speichern von Wrapping Datei", "*.cgr", CatFileSelectionModeSave)

wrapping1.Activate

---

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

---

Servus

Also die FileSelectionBox liefert dir nur einen Pfad und speichert/lädt direkt nicht.
Es müsst ungefähr so aussehen (ungetestet)

Code:

---

strPathForCgr = CATIA.FileSelectionBox("Speichern von Wrapping Datei", "*.cgr", CatFileSelectionModeSave)
wrapping1.SaveAs (strPathForCgr)

---

Gruß
Bernd

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

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