What is the correct command to force sketchmanager to recognize planes other than in the xy direction. The below macro works well when working on the XY plane, but fails completely to recognize and reorient a sketch to any other plane. I looked at swRefPlane.Transform as a possible solution, but am not understanding 1) if it is the real solution, 2) how to implement it.
'Precondition:
' 1)part is open, close all sketches
' 2)pick on a spline from a sketch
'Post condition:
' 1) reference points are located along curve, evenly distributed
' 2) reference plane is placed coincident with 2d sketch of points, and renamed for future access
' 3) sketch points are located directly over reference points
' 4) currently an issue with sketch orientation working correctly, XY works fine, others do not
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 reference plane coincident with spline
Dim myRefPlane As Feature
swSketchSeg.Select4 True, Nothing
swSelMgr.SetSelectedObjectMark 2, 1, swSelectionMarkAction_e.swSelectionMarkSet
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(0, 0, swRefPlaneReferenceConstraints_e.swRefPlaneReferenceConstraint_Coincident, 0, 0, 0)
myRefPlane.Name = "ThePlaneToSketchOn"
'---REQUIRED CODE HERE FOR LIKING REFERENCE PLANE WITH FUTURE SKETCH
'--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