2 Replies Latest reply on Dec 21, 2018 11:14 AM by Jure Košir

    Macro to divide selected segment with equalsegment

    Al Beau

      I'm not quite sure how to use the API for a process. I have a sketch open and I want the user to have a spline sketch entity selected and the api will use the equalsegment applied with user input on the number of sketch segments along the path. I'm not sure how to get the current sketch entity selected for this problem. The API has a vast amount of information and I was hoping someone could guide me in the right direction.

       

       

      Equalsegment tool for the spline

      2017 SOLIDWORKS API Help - EqualSegment Method (ISketchSegment)

       

      Useritemselect? Just want to use the line

        • Re: Macro to divide selected segment with equalsegment
          Jacob Corder

          if the segment is selected then this will work, i didnt test it but it should

          if you want it split into sketch points

           

          Function SplitSegment(ByVal SplitCt As Integer) As Boolean

                  Dim Part As ModelDoc2

                  Dim swApp As SldWorks = Application.SldWorks

                  Set Part = swApp.ActiveDoc

                  Dim SelMgr As SelectionMgr

                  Set SelMgr = Part.SelectionManager

                  If SelMgr.GetSelectedObjectCount2(-1) = 1 Then

                      If SelMgr.GetSelectedObjectType3(1, -1) = swSelectType_e.swSelSKETCHSEGS Then

                          Dim SkSeg As SketchSegment

                        Set SkSeg = SelMgr.GetSelectedObject6(1, -1)

                        SplitSegment = SkSeg.EqualSegment(swSketchSegmentType_e.swSketchSegmentType_sketchpoints, SplitCt)

                      End If

                  End If

              End Function

            • Re: Macro to divide selected segment with equalsegment
              Jure Košir

              I am complete newbie when it comes to macros. Anyways, my goal is to split spline into number of points. I found one macro that does this very well, but the problem for me is that points that split the spline are "equally distanced" in terms of distance along the spline. As a result I get points, which are not equally distanced in terms of x coordinate which is what I want to do...

               

              I have an idea to split x-axis into equally distanced points and then project them on the spline to get points which have the same "step" in x coordinate. But I just simply have no knowledge to execute this I don't even know if this is a good idea. Any help would be very helpful...

               

              I attached image below for better understanding. Orange arrow is along the spline and is equally distanced but x1 does not equal to x2, which is my goal...

               

              Equally distanced points problem.jpg

              MACRO:

               

              Option Explicit

               

              Dim swApp                       As SldWorks.SldWorks

               

              Dim swModel                     As SldWorks.ModelDoc2

               

              Dim swSelMgr                    As SldWorks.SelectionMgr

               

              Dim vFeatArr                    As Variant

               

              Dim swFeatMgr                   As SldWorks.FeatureManager

               

              Dim swModelDocExt               As SldWorks.ModelDocExtension

               

              Dim swSpline                    As SldWorks.SketchSpline

               

              Dim vFeat                       As Variant

               

              Dim swFeat                      As SldWorks.Feature

               

              Dim swRefPt                     As SldWorks.RefPoint

               

              Dim swRefPtData                 As SldWorks.RefPointFeatureData

               

              Dim swMathPt                    As SldWorks.MathPoint

               

              Dim swSkPt As SketchPoint

               

              Dim swMgr As SketchManager

               

              Dim nStatus                     As Long

               

              Dim bRet                        As Boolean

               

              Dim boolstatus                  As Boolean

               

              Dim i                           As Long

               

               

               

              Sub main()

               

               

               

                  Set swApp = Application.SldWorks

               

                  Set swModel = swApp.ActiveDoc

               

                  Set swSelMgr = swModel.SelectionManager

               

                  Set swFeatMgr = swModel.FeatureManager

               

                  Set swModelDocExt = swModel.Extension

               

               

               

                  If Not swSelMgr.GetSelectedObjectType3(1, -1) = swSelEXTSKETCHSEGS Then

               

                      MsgBox "select spline"

               

                      Exit Sub

               

                  End If

               

               

               

                  Dim Spline As Object

               

               

               

                  Set Spline = swSelMgr.GetSelectedObject6(1, -1)

               

               

               

                  vFeatArr = swFeatMgr.InsertReferencePoint(swRefPointAlongCurve, swRefPointAlongCurveEvenlyDistributed, 0#, 300)

               

                 

                 

               

               

               

                  Set swMgr = swModel.SketchManager

               

                  swModel.ClearSelection2 True

               

                  swModel.Insert3DSketch2 False

               

                  swMgr.AddToDB = True

               

               

               

                  For Each vFeat In vFeatArr

               

                      Set swFeat = vFeat

               

                      Set swRefPt = swFeat.GetSpecificFeature2

               

                      Set swRefPtData = swFeat.GetDefinition

               

                      Set swMathPt = swRefPt.GetRefPoint

               

               

               

                      Set swSkPt = swMgr.CreatePoint(swMathPt.ArrayData(0), swMathPt.ArrayData(1), swMathPt.ArrayData(2))

               

                  Next

               

                  swMgr.AddToDB = False

               

                  swModel.ClearSelection2 True

               

                  swModel.Insert3DSketch2 True

               

              End Sub