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