VBA 二次开发小程序，多几何体零件，快速删除空几何体

Sub CATMain()

Dim selection1 As Selection

Set Document = CATIA.ActiveDocument

Set Bodies = Document.Part.Bodies

Set selection1 = Document.Selection

For i = 1 To Bodies.Count

If CheckEmptyBody(Bodies.Item(i)) = True Then

selection1.Add Bodies.Item(i)

End If

Next

selection1.Delete

MsgBox 'Empty Bodies Deleted '

End Sub

Function CheckEmptyBody(body) As Boolean

Dim HybridShapes As HybridShapes

Dim ogs As OrderedGeometricalSets

Dim shapes As shapes

Dim Sketches1 As Sketches

Set HybridShapes = body.HybridShapes

Set ogs = body.OrderedGeometricalSets

Set shapes = body.shapes

Set Sketches = body.Sketches

On Error Resume Next

Count1 = HybridShapes.Count

Count2 = ogs.Count

Count3 = shapes.Count

Count4 = Sketches.Count

On Error GoTo 0

If Count1 = 0 And Count2 = 0 And Count3 = 0 And Count4 = 0 Then

CheckEmptyBody = True

Else

CheckEmptyBody = False

End If

End Function