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 parameters1 As Parameters
Set parameters1 = part1.Parameters

Err.Clear

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

If Err <> 0 Then
    Box = MsgBox("Keine Datum-Flaeche mit Namen 'Surface_with_holes' gefunden." & Chr(10) & Chr(10) & " Makro schliesst jetzt.", vbCritical, "Makro beendet - www.tobeplus.de")
    Exit Sub
End If

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

Dim GS_Boundaries As HybridBody
Set GS_Boundaries = hbs.Item("Boundaries_Separated")

If Err <> 0 Then
    Box = MsgBox("Sie muessen zuerst das erste Makro ablaufen lassen," & Chr(10) & " um die separierten Boundaries zu erzeugen!" & Chr(10) & Chr(10) & "Makro schliesst jetzt.", vbCritical, "Makro beendet - www.tobeplus.de")
    Exit Sub
End If

Dim Tangency As Long

Box = MsgBox("Makrolauf 1 war OK, es geht weiter mit dem Fuellen der separierten" & Chr(10) & "Boundaries und dem Erzeugen einer gesamten geschlossenen Flaeche." & Chr(10) & Chr(10) & "Füllen der Flaechen: " & Chr(10) & "YES/JA - Curvature/Kruemmungsstetig" & Chr(10) & "NO/NEIN - Tangency/Tangentenstetig" & Chr(10) & "CANCEL/ABBRECHEN - Point/Punktstetig", vbYesNoCancel, "Macro created by Thomas Berger - www.tobeplus.de")
If Box = 6 Then
    Tangency = 2
End If
If Box = 7 Then
    Tangency = 1
End If
If Box = 2 Then
    Tangency = 0
End If


Dim GS_Fills As HybridBody
Set GS_Fills = hbs.Add
GS_Fills.Name = "Filled_Boundaries"

Dim hybridShapeFill1 As HybridShapeFill
Dim hybridShapeCurveExplicit1 As Object
Dim curvereference As Reference

For i = 2 To GS_Boundaries.HybridShapes.Count
    
    Set hybridShapeFill1 = hsf.AddNewFill()
    
    Set hybridShapeCurveExplicit1 = GS_Boundaries.HybridShapes.Item(i)

    Set curvereference = part1.CreateReferenceFromObject(hybridShapeCurveExplicit1)

    hybridShapeFill1.AddBound curvereference
    hybridShapeFill1.AddSupportAtBound curvereference, hybridShapeSurfaceExplicit1
    
    hybridShapeFill1.Continuity = Tangency

    GS_Fills.AppendHybridShape hybridShapeFill1

Next

part1.Update

Dim GS_Result As HybridBody
Set GS_Result = hbs.Add
GS_Result.Name = "Resulting_Closed_Surface"

Dim reference2 As Reference
Set reference2 = GS_Fills.HybridShapes.Item(1)

Dim hybridShapeAssemble1 As HybridShapeAssemble
Set hybridShapeAssemble1 = hsf.AddNewJoin(reference1, reference2)


For i = 2 To GS_Fills.HybridShapes.Count
    Set nextreference = GS_Fills.HybridShapes.Item(i)
    hybridShapeAssemble1.AddElement nextreference
Next

hybridShapeAssemble1.SetConnex 0

hybridShapeAssemble1.SetManifold 0

hybridShapeAssemble1.SetSimplify 0

hybridShapeAssemble1.SetSuppressMode 0

hybridShapeAssemble1.SetDeviation 0.001

hybridShapeAssemble1.SetAngularToleranceMode 0

hybridShapeAssemble1.SetAngularTolerance 0.5

hybridShapeAssemble1.SetFederationPropagation 0

GS_Result.AppendHybridShape hybridShapeAssemble1

part1.InWorkObject = hybridShapeAssemble1

part1.Update

CATIA.StatusBar = ""

If Err <> 0 Then
    Box = MsgBox("Fehler waehrend des Makrolaufs, bitte das Resultat pruefen." & Chr(10) & Chr(10) & " Makro schliesst jetzt.", vbCritical, "Makrolauf fehlerhaft beendet - www.tobeplus.de")
    Exit Sub
Else
    Box = MsgBox("Die geschlossene Join-Flaeche konnte erstellt werden." & Chr(10) & Chr(10) & " Makro schliesst jetzt.", vbOKOnly, "Makrolauf erfolgreich beendet - www.tobeplus.de")
End If

Sel.Clear

For i = 1 To part1.HybridBodies.Count
    Sel.Add part1.HybridBodies.Item(i)
Next

Dim visPropertySet1 As VisPropertySet
Set visPropertySet1 = Sel.VisProperties

Set visPropertySet1 = visPropertySet1.Parent

visPropertySet1.SetShow 1

Sel.Clear

Sel.Add GS_Result

visPropertySet1.SetShow 0


End Sub
