---

hallo!

ich bin gerade am ausmisten innerhalb von modellen. ich hab V4 modelle (baugruppen) konvertiert, wo ich eigentlich keine normteile drin haben will, damit die files kleiner und das gesamte assy performanter wird. wir sprechen hier von mehreren tausend teilen mit hunderten von normteilen.

gibt es eine einfache möglichkeit nach leeren bodies zu suchen? ich hab bis jetzt nix gefunden (auch mit der forensuche).

irgendwelche ideen wie ich da vorgehen könnte?

die normteile lassen sich über farbe auswählen, wenn ich dann lösche, werden nur die solids innerhalb des bodies geschlöcht, die leeren bodies bleiben aber im modell.

gruß
mario

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

---

Hallo kalanja,

sofern Du den Q-Checker zur Verfügung hast:
Kriterium "leere Körper"
Findet und löscht leere Körper wie der Name schon vermuten lässt.

mfg
music

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

---

danke für den tipp, mal schauen ob ich den irgendwo her bekomme.

gruß und schönes WE
mario

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

---

Servus
Oder kurz ein Makro dafür schreiben
Der kern des Makros könnte so aussehen:

Code:

---

Language="VBSCRIPT"

Sub CATMain()
Set oDoc = CATIA.ActiveDocument
Set oPart = oDoc.Part
Set oSel = oDoc.Selection

oSel.clear
'Schleife über alle Bodies
for x = oPart.bodies.count to 1 step -1
  Set oBody = oPart.bodies.item(x)
  if oBody.shapes.count =0 then
        oSel.add oBody
        oSel.delete
        oSel.clear
  end if
next
End Sub

---

Gruß
Bernd

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

[Diese Nachricht wurde von bgrittmann am 16. Apr. 2010 editiert.]

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

---

cad.de da werden sie geholfen ;-)

hat perfekt funktioniert, danke!!

gruß
mario

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

---

Hallo,

das Makro ist sehr hilfreich. Danke!

Gruß, David

------------------
CatiaV5R19SP9HF20, XP Prof x64 SP2, Intel Xeon W3520 2,67GHz, 12GB RAM, NVIDIA Quadro FX 580

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

---

Hey das Ding such ich schon ewig ist super,
gibt es dies vielleicht auch mit leeren Geometrischen Sets?

Kenne mich mit Makros leider zu wenig aus.

Gruß Cimnese

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

---

Versuch das mal, is allerdings VS2010

Code:

---

Private Sub Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button5.Click
        Dim CATIA
        CATIA = GetObject(, "CATIA.application")

        Dim oDoc
        Dim oPart
        Dim oSel
        Dim oGeoSet

        oDoc = CATIA.ActiveDocument
        oPart = oDoc.Part
        oSel = oDoc.Selection

        oSel.clear()
        'Schleife über alle GeoSets
        For x = oPart.HybridBodies.count To 1 Step -1
            oGeoSet = oPart.HybridBodies.item(x)
            If oGeoSet.HybridShapes.Count = 0 And oGeoSet.HybridSketches.Count = 0 Then
                oSel.add(oGeoSet)
                oSel.delete()
                oSel.clear()
            End If
        Next

        MsgBox("Makro is' fertig!")

    End Sub

---

Gruß
Peter

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

---

Servus Peter
Kleine Ergänzung dazu:
ich würde noch prüfen ob in dem GeoSet keine weiteren GeoSets sind:

Code:

---

If oGeoSet.HybridShapes.Count = 0 And oGeoSet.HybridSketches.Count = 0 And oGeoSet.HybridBodies.count = 0 Then

---

Gruß
Bernd

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

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

---

GeoSet_Loeschen.jpg

Moin Bernd,
Du hast recht, und es ist noch mehr verbesserungswürdig, s.Anhang
Gruß
Peter

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

---

Hallo zusammen,

schau mal hier, da sollte so ziemlich alles drin sein, was dieses Thema abdeckt...

Code:

---

    Public Function Check_Part_IsEmpty(ByVal CheckPart As MECMOD.Part, Optional ByRef EmptyElements() As String = Nothing, Optional ByRef isSurfaceModel As Boolean = False) As Boolean

        '-------------------------------------------------------------------------------
        ' checks if the Part is not empty
        '-------------------------------------------------------------------------------
        ' True = Part is empty
        ' False = Part is not empty
        ' Optional EmptyElements: Returns a List of Empty Features and Bodies
        ' Optional isSurfaceModel: Returns if Body(solid) or HybridBody(only surfaces) is used
        '-------------------------------------------------------------------------------

        Dim oBodies As MECMOD.Bodies
        Dim oBody As MECMOD.Body
        Dim oHybBody As MECMOD.HybridBody
        Dim oHybBodies As MECMOD.HybridBodies
        Dim oSketches As MECMOD.Sketches
        Dim oSketch As MECMOD.Sketch
        Dim i As Integer = 0
        Dim FoundGeometry As Boolean = False
        Dim FoundSurfaces As Boolean = False
        Dim IsEmpty As Boolean = True

        Try

            oBodies = CheckPart.Bodies
            For Each oBody In oBodies
                If oBody.Shapes.Count = 0 And oBody.Sketches.Count = 0 And oBody.HybridBodies.Count = 0 Then
                    If IsNothing(EmptyElements) = False Then
                        EmptyElements(EmptyElements.Count - 1) = "Körper" & "Ÿ" & oBody.Name & "Ÿ" & CheckPart.Name & "\" & oBody.Name
                        ReDim Preserve EmptyElements(EmptyElements.Count)
                    End If
                Else
                    If oBody.Sketches.Count <> 0 Then
                        oSketches = oBody.Sketches
                        For i = 1 To oSketches.Count
                            oSketch = oSketches.Item(i)
                            If oSketch.GeometricElements.Count = 0 Then
                                If IsNothing(EmptyElements) = False Then
                                    EmptyElements(EmptyElements.Count - 1) = "Skizze" & "Ÿ" & oSketch.Name & "Ÿ" & CheckPart.partnumber & "\" & oBody.Name & "\" & oSketch.Name
                                    ReDim Preserve EmptyElements(EmptyElements.Count)
                                End If
                            End If
                            Application.DoEvents()
                        Next
                    End If
                    FoundGeometry = True
                    IsEmpty = False
                End If
                Application.DoEvents()
            Next

            oHybBodies = CheckPart.HybridBodies
            For Each oHybBody In oHybBodies
                If oHybBody.HybridShapes.Count = 0 And oHybBody.HybridSketches.Count = 0 And oHybBody.HybridBodies.Count = 0 Then
                    If IsNothing(EmptyElements) = False Then
                        EmptyElements(EmptyElements.Count - 1) = "Körper" & "Ÿ" & oHybBody.Name & "Ÿ" & CheckPart.Name & "\" & oHybBody.Name
                        ReDim Preserve EmptyElements(EmptyElements.Count)
                    End If
                Else
                    If oHybBody.HybridShapes.Count <> 0 Then
                        FoundSurfaces = True
                    End If
                    IsEmpty = False
                End If
                Application.DoEvents()
            Next

            If FoundGeometry = False And FoundSurfaces = True Then
                isSurfaceModel = True
            End If

            Return IsEmpty

        Catch ex As Exception

            EmptyElements(EmptyElements.Count - 1) = "Fehler" & "Ÿ" & "Fehler" & "Ÿ" & "Fehler"
            ReDim Preserve EmptyElements(EmptyElements.Count)
            Return IsEmpty
            MsgBox(ex.ToString, MsgBoxStyle.Critical, "Fehler in Functions: Check_Part_IsEmpty")

        End Try

    End Function

---

Das ganze ist wohl im .Net und gehört zu einer Eigenentwicklung ala QChecker; sollte aber alles auch für VBA ableitbar sein...

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

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

---

Hallo Leut,

ich hab mal versucht die Quersumme aus den bisherigen Lösch-Beiträgen zusammen zu fassen.
Ergebnis nachfolgend:

Code:

---

Dim oSel As Selection

Sub CATMain()
  Dim oDoc As PartDocument
  Dim oPart As Part
  Dim oBody As Body
  Dim oHB As HybridBody
  Dim n As Integer
 
  Set oDoc = CATIA.ActiveDocument
  Set oPart = oDoc.Part
  Set oSel = oDoc.Selection
 
  CATIA.RefreshDisplay = False
  DelEmptyGeoSets oPart

  oSel.Clear
  'Schleife über alle Bodies
  For n = oPart.Bodies.Count To 1 Step -1
      Set oBody = oPart.Bodies.Item(n)
      DelEmptyGeoSets oBody
      If (oBody.Shapes.Count + oBody.hybridBodies.Count + oBody.Sketches.Count = 0) _
        And Not (oBody Is oPart.MainBody) Then
        oSel.Add oBody
        'Debug.Print oBody.Name
        oSel.Delete
        oSel.Clear
      End If
  Next
  CATIA.RefreshDisplay = True
  oPart.Update
  DoEvents
End Sub

Function DelEmptyGeoSets(oParent As Object) As Integer
  Dim oHB As HybridBody
  Dim n  As Integer
  Dim i  As Integer
 
  oSel.Clear
  'part-hybrid-bodies
  For n = oParent.hybridBodies.Count To 1 Step -1
      Set oHB = oParent.hybridBodies.Item(n)
      If oHB.hybridBodies.Count > 0 Then DelEmptyGeoSets oHB
      If (oHB.GeometricElements.Count + oHB.HybridSketches.Count + oHB.HybridShapes.Count) = 0 Then
        oSel.Add oHB
        i = i + 1
        'Debug.Print oHB.Name
        oSel.Delete
        oSel.Clear
      End If
  Next
  DelEmptyGeoSets = i
End Function

---

Das Skript löscht zuerst alle leeren Geosets im Part, danach alle leeren Parts.
Falls ein Geoset im Geoset im Part liegt etc., wird das auch rekursiv untersucht.

Berichtet!

Enjoy,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

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

---

Hallo Joe,

der 1. Fall (Anhang oberes Bild) gelöst
der 2. Fall (unteres Bild) nicht gelöst

dennoch schönen Dank

Gruß
Peter

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

---

Hallo Peter,

zu Fall 2: Heisst das, dass der Set gelöscht wird?

Tschau,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

[Diese Nachricht wurde von joehz am 23. Jul. 2015 editiert.]

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

---

Hallo Joe,

ja, das komplette Geo-Set inkl. Linie

Gruß
Peter

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

---

Hallo Joe,
muß ich diesen Code als VB script in mein Makro kopieren ?

Wie gesagt bin kein Makro Spezialist

Gruß

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

---

OK. Zweiter Versuch. Fall2:

Code:

---

Dim oSel As Selection

Sub CATMain()
  Dim oDoc As PartDocument
  Dim oPart As Part
  Dim oBody As Body
  Dim oHB As HybridBody
  Dim n As Integer
 
  Set oDoc = CATIA.ActiveDocument
  Set oPart = oDoc.Part
  Set oSel = oDoc.Selection
 
  CATIA.RefreshDisplay = False
  DelEmptyGeoSets oPart

  oSel.Clear
  'Schleife über alle Bodies
  For n = oPart.Bodies.Count To 1 Step -1
      Set oBody = oPart.Bodies.Item(n)
      DelEmptyGeoSets oBody
      If (oBody.Shapes.Count + oBody.hybridBodies.Count + oBody.Sketches.Count = 0) _
        And Not (oBody Is oPart.MainBody) Then
        oSel.Add oBody
'        Debug.Print oBody.Name
        oSel.Delete
        oSel.Clear
      End If
  Next
  CATIA.RefreshDisplay = True
  oPart.Update
'  DoEvents
End Sub

Function DelEmptyGeoSets(oParent As Object) As Integer
  Dim oHB As HybridBody
  Dim n  As Integer
  Dim i  As Integer
 
  oSel.Clear
  'part-hybrid-bodies
  For n = oParent.hybridBodies.Count To 1 Step -1
      Set oHB = oParent.hybridBodies.Item(n)
      If oHB.hybridBodies.Count > 0 Then DelEmptyGeoSets oHB
      If (oHB.GeometricElements.Count + oHB.HybridSketches.Count + _
        oHB.HybridShapes.Count + oHB.hybridBodies.Count) = 0 Then
        oSel.Add oHB
        i = i + 1
'        Debug.Print oHB.Name
        oSel.Delete
        oSel.Clear
      End If
  Next
  DelEmptyGeoSets = i
End Function

---

Ich hab die Abfrage um HybridBodies erweitert.
Ausserdem Hab ich die 'Debug.Print' und 'DoEvents' - Anweisungen auskommentiert.
Die Skript-Engine mag die scheinbar nicht.

@cimnese:
Entweder den Code komplett in eine Textdatei(Notepad) kopieren und
als 'DelEmptyBodies.CATScript' abspeichern oder
den Code im VBA-Editor in ein leeres Modul kopieren, Modul umbenennen, abspeichern.
Letztere Lösung kommt für Dich im Moment wohl weniger in Frage.

Have fun.

Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

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

---

Hey Joe danke für die super Erklärung,
jetzt hab es sogar ich hinbekommen, leere Sets nimmt er weg das mit einer Linie muss ich noch probieren.

Vielen Dank für die Mühe

Gruß

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

---

bmw_grundmodell.PNG

Hallo Leut',

Ich hab das Makro testhalber auf ein BMW-Grundmodell angewandt.
Falls die Modell-Struktur so aussieht, wie auf dem Bild:

Nachher sieht die Struktur anders aus :-)

Ob das OK ist, mus jeder selber wissen.

Tschau,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

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

---

Moin Joe,

Makro getestet und für sehr gut befunden,
vielen Dank

Und die Strukturen der Automobilisten sind mir schnuppe,
wir haben mit Autos nichts zu tun

Gruß
Peter

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

---

Hallo,

ich hab das Makro noch als catvba abgelegt:

http://catia2.cad.de/index.php/de/downloads/skripts-applikationen/246-delpartbodies-makro-loescht-alle-leeren-bodies-in-einem-part

Enjoy,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

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

---

Hallo zusammen.

Ich muss jetzt mal den alten Beitrag rauskramen und ich hoffe das mir noch jemand weiterhelfen kann.

Bei der suche nach einem Makro, das mir leere Geo-Sets löscht bin ich über das von Joe gestolpert.
Funktioniert soweit ganz gut. Danke dafür.

Was mir aber aufgefallen ist, leider löscht das Makro auch Geo-Sets in denen sich nur ein Axis System befindet.
Über den Sinn nur ein Axis System in einem Geo-Set zu haben lässt sich bestimmt streiten. Kommt aber durchaus mal vor.

Jetzt bin ich nach wie vor leider nicht so bewandert mit der Makro-Programmierung um das selbst auszubessern.

Ich haben versucht es da einzufügen wo es mir logisch erschien. Das hat dann aber dazu geführt das es nicht mehr funktionierte.   

Eingefügt hab ich folgendes:

Zitat:

---

Function DelEmptyGeoSets(oParent As Object) As Integer
  Dim oHB As HybridBody
  Dim n  As Integer
  Dim i  As Integer

  oSel.Clear
  'part-hybrid-bodies
  For n = oParent.hybridBodies.Count To 1 Step -1
      Set oHB = oParent.hybridBodies.Item(n)
      If oHB.hybridBodies.Count > 0 Then DelEmptyGeoSets oHB
      If (oHB.GeometricElements.Count + oHB.HybridSketches.Count + _
        oHB.HybridShapes.Count + oHB.hybridBodies.Count + o.HB.AxisSystems.Count) = 0 Then
        oSel.Add oHB
        i = i + 1
'        Debug.Print oHB.Name
        oSel.Delete
        oSel.Clear
      End If
  Next
  DelEmptyGeoSets = i
End Function

---

War aber nicht so wirklich zielführend.
Ist vielleicht jemand hier der mir sagen kann was nicht passt und wie ich es fixe?

Wäre sehr nett.

Schon mal Danke.

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

---

Servus

AFAIR kann man Achsensystem in GeoSet nicht direkt ansprechen.
Das geht vermutlich über den komplexeren Umweg: GeoSet selektieren und per Suche nach den Achsensystem in der Selektion suchen.

Gruß
Bernd

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

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