Sub CATMain()

    'Abfrage Dokumente
    If CATIA.Windows.Count = 0 Then
   Box = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgefuehrt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
   Exit Sub
   End If
        
    Set Dokument = CATIA.ActiveDocument
    If TypeName(Dokument) <> "PartDocument" Then
        Box = MsgBox("Das aktiv geladen Dokument ist KEIN CATPart!" + Chr(10) + "Bitte aktivieren sie ein CATPartt und starten sie das Makro erneut!", vbExclamation, "Abbruch falscher Dateityp")
        Exit Sub
    End If

 set Part_Collection = new Collection
 
Set Koerper = Dokument.Part.Bodies
 
for each body in Koerper
 Part_Collection.add Body.Name
 next
 
Part_Collection.sort
 
Set oSel = Dokument.Selection
 oSel.clear

Dim body1 As Body

Set body1 = Koerper.Add()

Dokument.Part.Update 

Dokument.Part.MainBody = body1
body1.Name = ("neuer_Hauptkörper")

Dokument.Part.Update 
 
for i = 1 to Part_Collection.Count
 oSel.add Koerper.Item(Part_Collection.Item(i)) 
oSel.copy
 oSel.clear
 oSel.add Dokument.Part
 oSel.Paste
 oSel.clear 
 oSel.add Koerper.Item(Part_Collection.Item(i))
 oSel.delete

next


end sub

'==================================================================================================
class Collection

    private Array()

    sub class_initialize()
      'Array mit 1 (leeren) Datenfeld anlegen'
      Redim Array(0)    
    end Sub
    

    'Element am Ende des Arrays hinzufuegen (automatische erweitern))_________________________________________

    public Sub add(Datenfeld)  
          Index = Ubound(Array)
          ReDim preserve Array((Index+1))
          Array(Index+1) = Datenfeld
    end Sub    
    
    'Datenfeld ausgeben___________________________________________

    public function Item(Index)
        'Ueberpruefen: Index zu hoch? Index 0 ist leer'
        if (Index <= 0 and Index > Ubound(Array)) then        
          Item = "ungueltiger Index"        
        Else    
          Item = Array(Index)          
        End If    
    end function
    
    
    'den Array aufsteigend sortieren'
    Sub sort
        'Bubblesort  
        for i = 1 to Ubound(Array)-1
          for u = i to Ubound(Array)
            if Array(i) > Array(u) then
                'temp-Variable schreiben, danach austauschen
                temp = Array(i) 
                Array(i) = Array(u)
                Array(u) = temp
            end if
          next
        next         
    end Sub
 
public function Count
 Count = Ubound(Array)
 end function

end class