Sub CATMain()

Set oPARTDoc = CATIA.ActiveDocument
Set oPart = oPARTDoc.Part
Set oBodies = oPart.Bodies
Set PartBody = oBodies.Item("PartBody")
oPart.InWorkObject = PartBody


Set oPARTDoc = CATIA.ActiveDocument
Set oSel = oPARTDoc.Selection

l= 0
For i = oPart.Bodies.Count To 1 Step -1
On Error Resume Next
Set oBody = oPart.Bodies.Item(i)
    If oBody.Shapes.Count = 0 And oBody.Sketches.Count = 0  Then
        oSel.Clear
        Set delBody = oBodies.Item(i)
        oSel.Add delBody
        oSel.Delete
		l=l+1
     End If
Next

Box= MsgBox("Es wurden " & l & " leere Bodys geloescht",,"Hinweis")

End Sub