Create planar surfaces on all regions of a sketch

Hello!

I'm trying to autmoatically fill every region of a sketch with individual planar surfaces and i have written a macro which selects all regions of the sketch and attempts to add a  surface for each one it finds. To Further calrify want i want to do, I basically want to automate Charles answer from this thread: multiple surfaces 3d sketch , but for a 2d sketch.
The problem i have is that the surfaces i add end upp in the same region, even though i select different regions before calling "InsertPlanarRefSurface()". I found this function by trying to record the process but i'm not sure if it's the right choice.

Any help or suggestion is would be highly appreciated!

This is the part of the code I'm having troubles with (some variables might be for other parts of the code that is not included):

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swSketch As SldWorks.Sketch

Dim vRegions As Variant

Dim vSegments As Variant

Dim swSkRegions As SldWorks.SketchRegion

Dim swskContours As SldWorks.SketchContour

Dim swFeat As SldWorks.Feature

Dim swFeatureMgr As SldWorks.FeatureManager

Dim SelMgr As SldWorks.SelectionMgr

Dim mySelectData As SldWorks.SelectData

Dim vEdgeArr As Variant

Dim swEdge As Edge

Dim swModeler As SldWorks.Modeler

Dim boolstatus As Boolean

Dim swselmgr As SldWorks.SelectionMgr

Sub main()

Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swFeatureMgr = swModel.FeatureManager

    Set SelMgr = swModel.SelectionManager

    boolstatus = swModel.Extension.SelectByID2("test_sketch", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

    Set swselmgr = swModel.SelectionManager

    Set swFeat = swselmgr.GetSelectedObject6(1, 0)

    Set swSketch = swFeat.GetSpecificFeature2

    vRegions = swSketch.GetSketchRegions()

    Dim i As Integer

    swModel.ClearSelection2 True

          For i = 0 To UBound(vRegions)

             Set swSkRegions = vRegions(i)

             swModel.SelectionManager.EnableContourSelection = True

             swSkRegions.Select2 False, Nothing

             boolstatus = swModel.InsertPlanarRefSurface()           

             swModel.ClearSelection2 True

             swModel.SelectionManager.EnableContourSelection = False

         Next

end sub

Meddelandet redigerades av: Gustav Carlberg forgot to append testpart