1 Reply Latest reply on Mar 10, 2017 3:26 AM by Ivana Kolin

    Set points on a curve, aligned to a grid

    Chris Christy

      So I am working with some curves that I would like to be able to add dimensional coordinates to, based off XY grid. My thoughts were to make a tangent construction line at each end of the curve in X direction then to get the XY coordinates every 1/2" or such. I can manually do this fairly easily but i was looking for a more automated way. Does anyone have any ideas, or even a  API direction to suggest for me to pursue? Any help will be greatly appreciated.

       

      I've added an example screenshot... I'd want to add points where the construction lines cross the Spline.

       

        • Re: Set points on a curve, aligned to a grid
          Ivana Kolin

          Is this exact enough?

           

          ' precondition: Select spline
          Option Explicit
          Const tol                                         As Double = 0.000001
          Const step                                        As Double = 0.0125
          
          
          Dim swApp                                         As SldWorks.SldWorks
          Dim Part                                          As SldWorks.ModelDoc2
          Dim bRet                                          As Boolean
          Dim longwarnings                                  As Long
          
          
          Sub main()
              Dim activeSketch                              As SldWorks.Sketch
              Dim swSketchMgr                               As SldWorks.SketchManager
              Dim swSelMgr                                  As SldWorks.SelectionMgr
              Dim swSketchSeg                               As SldWorks.SketchSegment
              Dim swCurve1                                  As SldWorks.Curve
              Dim swCurve2                                  As SldWorks.Curve
              Dim nStartParam                               As Double
              Dim nEndParam                                 As Double
              Dim bIsClosed                                 As Boolean
              Dim bIsPeriodic                               As Boolean
          
          
              Dim vStartPt                                  As Variant
              Dim vEndPt                                    As Variant
              Dim vTessPts                                  As Variant
          
          
              Dim value1                                    As Variant
              Dim value2                                    As Variant
              Dim mathUtil                                  As SldWorks.MathUtility
              Dim minX                                      As Double
              Dim minY                                      As Double
              Dim minZ                                      As Double
              Dim maxX                                      As Double
              Dim maxY                                      As Double
              Dim maxZ                                      As Double
              Dim i                                         As Integer
              Dim x                                         As Double
              minX = 1.7976931348623E+308
              minY = 1.7976931348623E+308
              minZ = 1.7976931348623E+308
              maxX = -1.7976931348623E+308
              maxY = -1.7976931348623E+308
              maxZ = -1.7976931348623E+308
          
          
          
          
              Set swApp = Application.SldWorks
          
          
              Set Part = swApp.ActiveDoc
              Set mathUtil = swApp.GetMathUtility
              Set swSelMgr = Part.SelectionManager
              If swSelMgr.GetSelectedObjectCount2(-1) <> 1 Then Exit Sub
              Set swSketchSeg = swSelMgr.GetSelectedObject6(1, -1)
          
          
              Set swSketchMgr = Part.SketchManager
              Set activeSketch = swSketchMgr.activeSketch
              If activeSketch Is Nothing Then Exit Sub
              Part.EditSketch
              Set swCurve1 = swSketchSeg.GetCurve
          
          
              bRet = swCurve1.GetEndParams(nStartParam, nEndParam, bIsClosed, bIsPeriodic): Debug.Assert bRet
              vStartPt = swCurve1.Evaluate(nStartParam)
              vEndPt = swCurve1.Evaluate(nEndParam)
              vTessPts = swCurve1.GetTessPts(tol, tol, (vStartPt), (vEndPt))
          
          
              If IsEmpty(vTessPts) Then Exit Sub
              ' Disable VBA range checking because tessellation points
              ' might not be a multiple of 6
              On Error Resume Next
              For i = 0 To UBound(vTessPts) Step 3
                  If minX > vTessPts(i) Then minX = vTessPts(i)
                  If minY > vTessPts(i + 1) Then minY = vTessPts(i + 1)
                  If minZ > vTessPts(i + 2) Then minZ = vTessPts(i + 2)
                  If maxX < vTessPts(i) Then maxX = vTessPts(i)
                  If maxY < vTessPts(i + 1) Then maxY = vTessPts(i + 1)
                  If maxZ < vTessPts(i + 2) Then maxZ = vTessPts(i + 2)
              Next i
          
          
              swSketchMgr.AddToDB = True
              If minX <> maxX And minY <> maxY Then
                  For x = minX To maxX Step step
                      Set swSketchSeg = swSketchMgr.CreateLine(x, minY, minZ, x, maxY, maxZ)
                      swSketchSeg.ConstructionGeometry = True
                      For i = 0 To UBound(vTessPts) - 3 Step 3
                          If vTessPts(i) = x Then
                              swSketchMgr.CreatePoint vTessPts(i), vTessPts(i + 1), vTessPts(i + 2)
                          ElseIf (vTessPts(i) > x And vTessPts(i + 3) < x) Or (vTessPts(i + 3) > x And vTessPts(i) < x) Then
                              Set swCurve2 = swSketchSeg.GetCurve
                              value1 = swCurve2.GetClosestPointOn(vTessPts(i), vTessPts(i + 1), vTessPts(i + 2))
                              value2 = swCurve2.GetClosestPointOn(vTessPts(i + 3), vTessPts(i + 4), vTessPts(i + 5))
                              swSketchMgr.CreatePoint x, (value1(1) + value2(1)) / 2, vTessPts(i + 2)
                          End If
                      Next i
                  Next
              End If
              swSketchMgr.AddToDB = False
              On Error GoTo 0
          End Sub