Mit folgendem Makro    lassen sich alle leeren Bodies/HybridBodies aus einem Part löschen.

Ursprung des Makros ist der Thread hier.


'---------------------------------------------------------------------------------------
' Module    : modDelEmpty
' Author    : jherzog
' Date      : 23.07.2015
' Purpose   : Delete Empty Bodies and HybridBodies from a CatPart
' Reqs.     : An opened CatPart
'---------------------------------------------------------------------------------------
'
Const strVersion As String = "V1.0"
Const strMacroName As String = "DelEmptyBodies"
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
   Dim i  As Integer                            'counter for hybridbodies
   Dim j  As Integer                            'counter for bodies
   
   Set oDoc = CATIA.ActiveDocument
   Set oPart = oDoc.Part
   Set oSel = oDoc.Selection
   
   CATIA.RefreshDisplay = False
'---------------------------------------------------------------------------------------
   i = DelEmptyGeoSets(oPart)                   'delete empty 'root' geosets from part

   oSel.Clear
   'Schleife über alle Bodies
   For n = oPart.Bodies.Count To 1 Step -1      'step backwards because of delete
      Set oBody = oPart.Bodies.Item(n)
      i = i + DelEmptyGeoSets(oBody)            'delete empty geosets in body
      If (oBody.Shapes.Count + oBody.hybridBodies.Count + oBody.Sketches.Count = 0) _
         And Not (oBody Is oPart.MainBody) Then 'skip 'PartBody'
         oSel.Add oBody
         j = j + 1                              'inc. counter
'         Debug.Print oBody.Name
         oSel.Delete                            'delete
         oSel.Clear
      End If
   Next
'---------------------------------------------------------------------------------------
   CATIA.RefreshDisplay = True
   oPart.Update
'   DoEvents
   CATIA.StatusBar = "Macro finished."
   MsgBox i & " empty hybridbodies and " & j & " empty bodies found and deleted.", _
      vbOKOnly Or vbInformation, strMacroName & " " & strVersion
End Sub

'---------------------------------------------------------------------------------------
' Procedure : DelEmptyGeoSets
' Author    : jherzog
' Date      : 23.07.2015
' Time      : 15:47
' Languages : VBA 6.5
' V5-Release: V5R19/21
' Purpose   : Delete empty geometric sets from parent
' Parms     : oParent:  Part or Body
' Ret. Value: Number of deleted bodies
'
' Syntax    : DelEmptyGeoSets oBody
'
' Prereqs   : an opened catpart
' Remarks   : checks for sketches, geosets, shapes and geometric elements
'---------------------------------------------------------------------------------------
'
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 set in set re-call
      If (oHB.GeometricElements.Count + oHB.HybridSketches.Count + _
         oHB.HybridShapes.Count + oHB.hybridBodies.Count) = 0 Then
         oSel.Add oHB               'if set is empty
         i = i + 1                  'inc. counter
'         Debug.Print oHB.Name
         oSel.Delete                'delete
         oSel.Clear
      End If
   Next
   DelEmptyGeoSets = i              'return number of deleted hybridbodies
End Function


 

Zum Seitenanfang