0 Replies Latest reply on Jan 18, 2017 1:12 PM by Gustav Carlberg

    Create planar surfaces on all regions of a sketch

    Gustav Carlberg

      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