Sub CATMain()

'On Error Resume Next

Dim oDoc As Document
Set oDoc = CATIA.ActiveDocument

If Err.Number <> 0 Then
    Err.Clear
    MsgBox "Kann auf kein geoeffnetes CATIA Dokument zugreifen", vbOKOnly, "Makro beendet - www.tobeplus.de"
    Exit Sub
End If

Dim DocType As String
DocType = TypeName(oDoc)
                
If DocType <> "PartDocument" Then ' CATIA CATPart vorhanden, SKRIPT laeuft weiter
    MsgBox "Bitte ein Part öffnen und danach das Makro starten", vbOKOnly, "Makro beendet - www.tobeplus.de"
    Exit Sub
End If

Dim part1 As part
Set part1 = oDoc.part

Dim hbs As HybridBodies
Set hbs = part1.HybridBodies

Dim hsf As HybridShapeFactory
Set hsf = part1.HybridShapeFactory

Dim Sel As selection
Set Sel = oDoc.selection

Dim Point As Reference

Dim Neues_GeoSet As HybridBody
Set Neues_GeoSet = hbs.Add

Neues_GeoSet.Name = "Boundaries"

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

Dim hybridShapeSurfaceExplicit1 As Parameter
Set hybridShapeSurfaceExplicit1 = parameters1.Item("Surface_with_holes")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit1)

Dim hybridShapeBoundary1 As HybridShapeBoundary
Set hybridShapeBoundary1 = hsf.AddNewBoundaryOfSurface(reference1)

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Neues_GeoSet.AppendHybridShape hybridShapeBoundary1
hybridShapeBoundary1.Name = "All_Boundaries"
part1.Update

CATIA.StatusBar = ""

Dim GS_Boundaries As HybridBody
Set GS_Boundaries = hbs.Add

GS_Boundaries.Name = "Boundaries_Separated"

Sel.Clear
Sel.Add hybridShapeBoundary1
CATIA.StartCommand ("Disassemble")

CATIA.RefreshDisplay = True

Box = MsgBox("Bitte auf 'domains only' und danach auf 'OK' klicken." & Chr(10) & Chr(10) & "Nach dem Zerlegen bitte das 2. Makro starten um die Loecher zu schliessen.", vbOKOnly, "Das Makro braucht ihre Unterstuetzung - created by Thomas Berger - www.tobeplus.de")

End Sub