Hide Table of Contents

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

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



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Return Untrimmed Curve Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2010 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.