2 Replies Latest reply on Sep 23, 2015 8:20 AM by John Christensen

    Sketch points over Reference points, not coinciding

    John Christensen

      I'm trying to use reference points created along a curve to place various sketch segments and sketch points.  I can get the reference points located, and also any number of sketch types located using the same points, or so it would seem, (lines, arcs, etc), yet the two do not match.

      The reference points are accurate.

      The sketch points are not.

      Yet they should be because they are supposedly using the same points.  One array gets the refpoints, same array creates the sketchpoints.

      If I could get past this part, there are number of other applications where I could use this format, if only it were accurate.




      '   1)part is open, close all sketches

      '   2)pick on a spline from either an edge or sketch

      'Post condition:
      '   1) reference points are located along curve
      '   2) sketch points are located directly over reference points
      '   3) currently there is a locating error for sketchpoint locations ??


      Sub main()
          Dim swApp                       As SldWorks.SldWorks
          Dim swModel                     As SldWorks.ModelDoc2
          Dim swSelMgr                    As SldWorks.SelectionMgr
          Dim swSketchSeg                 As SldWorks.SketchSegment
          Dim swCurve                     As SldWorks.Curve
          Dim swFeatMgr                   As SldWorks.FeatureManager
          Dim vFeatArr                    As Variant
          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 nStatus                     As Long
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set swSelMgr = swModel.SelectionManager
          Set swFeatMgr = swModel.FeatureManager
          Set swSketchSeg = swSelMgr.GetSelectedObject5(1)
          Set swCurve = swSketchSeg.GetCurve

          Dim NumofPoints As Integer
          NumofPoints = 40
          Debug.Print "Number of points to add "; NumofPoints
          Dim valueiseven As Boolean
          valueiseven = NumofPoints Mod 2
                 If valueiseven = False Then
                      NumofPoints = NumofPoints + 1
                 End If
      '--create reference points
          vFeatArr = swFeatMgr.InsertReferencePoint(swRefPointAlongCurve, swRefPointAlongCurveEvenlyDistributed, 0#, NumofPoints)
          Dim X As Double
          Dim PtArray2(500, 3) As Variant
          X = 1
          For Each vFeat In vFeatArr
              Set swFeat = vFeat
              Set swRefPt = swFeat.GetSpecificFeature2

              Set swMathPt = swRefPt.GetRefPoint
              PtArray2(X, 0) = swMathPt.ArrayData(0)
              PtArray2(X, 1) = swMathPt.ArrayData(1)
              PtArray2(X, 2) = swMathPt.ArrayData(2)
              X = X + 1

      Dim skSegment As SldWorks.SketchSegment
      Dim skpoint   As SldWorks.SketchPoint
      Dim I As Integer

          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set skSegment = swModel.SketchManager.Create3PointArc _
                    (PtArray2(1, 0), PtArray2(1, 1), 0#, _
                    PtArray2(1 + 2, 0), PtArray2(1 + 2, 1), 0#, _
                    PtArray2(1 + 1, 0), PtArray2(1 + 1, 1), 0#)
      '--create sketch points
              For I = 2 To (NumofPoints - 3) Step 2
                   Set skpoint = swModel.SketchManager.CreatePoint _
                     (PtArray2(I, 0), PtArray2(I, 1), 0#)
          swModel.ClearSelection2 True
          swModel.SketchManager.InsertSketch True
      End Sub