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.
'Precondition:
' 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
Next
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#)
Next
swModel.ClearSelection2 True
swModel.SketchManager.InsertSketch True
End Sub