AnsweredAssumed Answered

Sketching on a reference plane

Question asked by John Christensen on Sep 28, 2015

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

Outcomes