Macro for Extract and Fill

[FreddyFred]

Hey everybody,

i am new here and i hope, my question is in the right forum and i don't break any rules or something like that.

Like the topic said, i want to have a macro for catia that makes an extract and fill in the next step. The User should close holes with any structe in Partbodies. But if you have many holes
it should work faster, so with the macro will help to do it with just some clicks.

The idea is to do it this way:

1. User Selection which "Edge" should be extracted. Propagationtype is "point continuity".
- this type needs a support
2. User Selection for a "Face" that supports the extract.
(- here is the problem)

hybridShapeExtract1.Support = reference2

the whole code is following
3. the "Fill" takes the variable from the extract and choose it automatically
4. ask user if it's done or he wants to close another hole.

Until the special line everything works. But i don't understand why it stops there.
When i let this line out (with ') it works, but just with easy holes which don't need support.

I have recorded this Code and start to make it usefull for every partbody (individuel), but i have spend some hours with this mistake and i don't understand it.

Here is my Code:

'#############
'CLOSE SURFACE
'#############

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim MyCatiaDocument As Document
Set MyCatiaDocument = CATIA.ActiveDocument

Dim MsgBoxReturn1 As VbMsgBoxResult

Set UserSel1 = MyCatiaDocument.Selection

'##################
'USERSELECTION EDGE
'##################


MsgBoxReturn = MsgBox("select edge", vbOKCancel, "Auswahl Edge")

If MsgBoxReturn = vbCancel Then
     MsgBox "Selection stops"
    
    Exit Sub

Else
    
    Dim InputObjectType1(0)
    InputObjectType1(0) = "Edge"
    UserSel1.Clear
    Dim Status1
    Status1 = UserSel1.SelectElement2(InputObjectType1, "select Edge ", False)
       
    End If

'######################################
'EDGE [EXTRACT]
'######################################

'CreatReferenceFromObject -> Edge


Dim reference1 As Reference

Set reference1 = UserSel1.Item2(1).Reference


Dim hybridShapeExtract1 As hybridShapeExtract
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)

hybridShapeExtract1.PropagationType = 1 ' 1 = punktstetig

hybridShapeExtract1.ComplementaryExtract = False

hybridShapeExtract1.IsFederated = False

'##################
'USERSELECTION FACE
'##################

Dim MsgBoxReturn2 As VbMsgBoxResult
Set UserSel2 = MyCatiaDocument.Selection

MsgBoxReturn = MsgBox("select face", vbOKCancel, "Selection Face")

If MsgBoxReturn = vbCancel Then
     MsgBox "Selection stops"
    
    Exit Sub

Else
    
    Dim InputObjectType2(0)
    InputObjectType2(0) = "Face"
    UserSel2.Clear
    Dim Status2
    Status2 = UserSel2.SelectElement2(InputObjectType2, "select face", False)
       
    End If

part1.Update

'######################################
'FACE [EXTRACT]
'######################################

'CreateReferenceFromGeometry -> Face

Dim reference2 As Reference

Set reference2 = UserSel2.Item2(1).Reference

'############################
'the reference needs to be included

'[COLOR=#EF2929]here is the special line, where everything stops[/color]
'[COLOR=#EF2929]hybridShapeExtract1.Support = reference2[/color]

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim GeoSet As HybridBody
Set GeoSet = hybridBodies1.Add

GeoSet.Name = "Geometrical Set Close Surface"

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set Close Surface") 'Speicherort des Extracts

hybridBody1.AppendHybridShape hybridShapeExtract1

part1.InWorkObject = hybridShapeExtract1

part1.Update

'######################################
'FILL
'######################################

'take reference/variable of boundary 

Dim hybridShapeFill1 As HybridShapeFill
Set hybridShapeFill1 = hybridShapeFactory1.AddNewFill()

Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(hybridShapeExtract1)

hybridShapeFill1.AddBound reference3

hybridShapeFill1.Continuity = 0

hybridBody1.AppendHybridShape hybridShapeFill1

part1.InWorkObject = hybridShapeFill1

part1.Update

'######################################
'MSGBOX
'######################################

'close the next hole? or ready and exit Macro

End Sub

thank you for every help.
if some other informations are needed, let me know it.