Return Untrimmed Curve Example (VBA)

This example shows how to return an untrimmed curve.

 

'------------------------------------------------

'

' Preconditions: Part is open and face is selected.

'

' Postconditions: 3D sketch is created.

'

'-------------------------------------------------

Option Explicit

Sub CreateTessCurve _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swCurve As SldWorks.curve _

)

    Const nChordTol             As Double = 0.001

    Const nLengthTol            As Double = 0.001

    Dim nStartParam             As Double

    Dim nEndParam               As Double

    Dim bIsClosed               As Boolean

    Dim bIsPeriodic             As Boolean

    Dim vStartPt                As Variant

    Dim vEndPt                  As Variant

    Dim vTessPts                As Variant

    Dim swSketchSeg             As SldWorks.SketchSegment

    Dim i                       As Long

    Dim bRet                    As Boolean

        

    bRet = swCurve.GetEndParams(nStartParam, nEndParam, bIsClosed, bIsPeriodic): Debug.Assert bRet

    

    vStartPt = swCurve.Evaluate(nStartParam)

    vEndPt = swCurve.Evaluate(nEndParam)

    

    ' Only makes sense for trimmed curves

    Debug.Assert swCurve.IsTrimmedCurve

    vTessPts = swCurve.GetTessPts(nChordTol, nLengthTol, (vStartPt), (vEndPt))

    

    swModel.Insert3DSketch2 False

    swModel.SetAddToDB True

    swModel.SetDisplayWhenAdded False

    

    ' Disable VB range checking since tessellation points

    ' cannot be a multiple of 6

     On Error Resume Next

    For i = 0 To UBound(vTessPts) Step 3

        Set swSketchSeg = swModel.CreateLine2( _

                            vTessPts(i + 0), vTessPts(i + 1), vTessPts(i + 2), _

                            vTessPts(i + 3), vTessPts(i + 4), vTessPts(i + 5))

    Next i

    On Error GoTo 0

    swModel.SetDisplayWhenAdded True

    swModel.SetAddToDB False

    swModel.Insert3DSketch2 True

    

    bRet = swModel.EditRebuild3: Debug.Assert bRet

End Sub

Sub main()

    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swSelMgr                    As SldWorks.SelectionMgr

    Dim swFace                      As SldWorks.face2

    Dim swSurf                      As SldWorks.surface

    Dim vFaceUV                     As Variant

    Dim vSurfParam                  As Variant

    Dim swCurveU                    As SldWorks.curve

    Dim swCurveV                    As SldWorks.curve

    Dim vUIsoStartPt                As Variant

    Dim vUIsoEndPt                  As Variant

    Dim vVIsoStartPt                As Variant

    Dim vVIsoEndPt                  As Variant

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swFace = swSelMgr.GetSelectedObject5(1)

    Set swSurf = swFace.GetSurface

    vFaceUV = swFace.GetUVBounds

    vSurfParam = swSurf.Parameterization

    

    vUIsoStartPt = swSurf.Evaluate((vFaceUV(0) + vFaceUV(1)) / 2#, vFaceUV(2), 0, 0)

    vUIsoEndPt = swSurf.Evaluate((vFaceUV(0) + vFaceUV(1)) / 2#, vFaceUV(3), 0, 0)

    

    vVIsoStartPt = swSurf.Evaluate(vFaceUV(0), (vFaceUV(2) + vFaceUV(3)) / 2#, 0, 0)

    vVIsoEndPt = swSurf.Evaluate(vFaceUV(1), (vFaceUV(2) + vFaceUV(3)) / 2#, 0, 0)

    

    Debug.Print "File = " & swModel.GetPathName

    Debug.Print "  Face:"

    Debug.Print "    uRange   = [" & vFaceUV(0) & " , " & vFaceUV(1) & "]"

    Debug.Print "    vRange   = [" & vFaceUV(2) & " , " & vFaceUV(3) & "]"

    Debug.Print "  Surface:"

    Debug.Print "    uRange   = [" & vSurfParam(0) & " , " & vSurfParam(1) & "]"

    Debug.Print "    vRange   = [" & vSurfParam(2) & " , " & vSurfParam(3) & "]"

    Debug.Print "  U Iso Curve:"

    Debug.Print "    Start Pt = (" & vUIsoStartPt(0) * 1000 & ", " & vUIsoStartPt(1) * 1000 & ", " & vUIsoStartPt(2) * 1000 & ") mm"

    Debug.Print "    End   Pt = (" & vUIsoEndPt(0) * 1000 & ", " & vUIsoEndPt(1) * 1000 & ", " & vUIsoEndPt(2) * 1000 & ") mm"

    Debug.Print "  V Iso Curve:"

    Debug.Print "    Start Pt = (" & vVIsoStartPt(0) * 1000 & ", " & vVIsoStartPt(1) * 1000 & ", " & vVIsoStartPt(2) * 1000 & ") mm"

    Debug.Print "    End   Pt = (" & vVIsoEndPt(0) * 1000 & ", " & vVIsoEndPt(1) * 1000 & ", " & vVIsoEndPt(2) * 1000 & ") mm"

    

    ' Curves are untrimmed

'    Set swCurveU = swSurf.MakeIsoCurve(False, (vSurfParam(0) + vSurfParam(1)) / 2#): Debug.Assert Not swCurveU Is Nothing

'    Set swCurveV = swSurf.MakeIsoCurve(True, (vSurfParam(2) + vSurfParam(3)) / 2#): Debug.Assert Not swCurveV Is Nothing

    

    ' Curves are untrimmed

    Set swCurveU = swSurf.MakeIsoCurve(False, (vFaceUV(0) + vFaceUV(1)) / 2#): Debug.Assert Not swCurveU Is Nothing

    Set swCurveV = swSurf.MakeIsoCurve(True, (vFaceUV(2) + vFaceUV(3)) / 2#): Debug.Assert Not swCurveV Is Nothing

    

    ' So trim to start/end of UV ranges

    Set swCurveU = swCurveU.CreateTrimmedCurve2(vUIsoStartPt(0), vUIsoStartPt(1), vUIsoStartPt(2), vUIsoEndPt(0), vUIsoEndPt(1), vUIsoEndPt(2)): Debug.Assert Not swCurveU Is Nothing

    Set swCurveV = swCurveV.CreateTrimmedCurve2(vVIsoStartPt(0), vVIsoStartPt(1), vVIsoStartPt(2), vVIsoEndPt(0), vVIsoEndPt(1), vVIsoEndPt(2)): Debug.Assert Not swCurveV Is Nothing

    

    CreateTessCurve swApp, swModel, swCurveU

    CreateTessCurve swApp, swModel, swCurveV

End Sub

'------------------------------------------------