AnsweredAssumed Answered

Sketch points over Reference points, not coinciding

Question asked by John Christensen on Sep 22, 2015
Latest reply on Sep 23, 2015 by 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