Approximating a Sketch Curve with Line Segments

Here’s another little VBA macro that I wrote that might be interesting to some of you.  This one takes any sketch curve (circle, arc, spline, ellipse, or elliptical arc) as input, along with the number of segments to break the curve into.  It then creates sketch lines along the curve.  It also sets the original curve to be construction geometry.

This mostly uses the curve geometry query functionality in the API and also demonstrates creating a sketch.  I’ve tried to add comments to the code to help in understanding what it’s doing. 

Public Sub CreateSegmentedCurve()
    ' Check to see that a curved sketch entity is selected.
    Dim entity As SketchEntity
    On Error Resume Next
    Set entity = ThisApplication.ActiveDocument.SelectSet.Item(1)
    If Err.Number <> 0 Then
        MsgBox "A curved sketch entity must be selected."
        Exit Sub
    End If
    On Error GoTo 0 

    If TypeOf entity Is SketchPoint Or _
                                  TypeOf entity Is SketchLine Then
        MsgBox "A curved sketch entity must be selected."
        Exit Sub
    End If 

    ' Ask for the number of segments to break the curve into.
    Dim prompt As String
    prompt = "Enter the number of segments for the curve."
    Dim segmentCount As Integer
    segmentCount = Val(InputBox(prompt, "Number of Segments", "10"))
    If segmentCount = 0 Then
        MsgBox "Invalid segment count."
        Exit Sub
    End If 

    ' Get the parent sketch.
    Dim sk As sketch
    Set sk = entity.Parent 

    ' Get the evaluator from the associate geometry.
    Dim curveEval As Curve2dEvaluator
    Set curveEval = entity.Geometry.Evaluator
    Dim minU As Double
    Dim maxU As Double
    Call curveEval.GetParamExtents(minU, maxU) 

    ' Determine if the entity is open or closed (circle,
    ' ellipse, or closed spline)
    Dim curveIsClosed As Boolean
    curveIsClosed = False
    If TypeOf entity Is SketchCircle Or _
       TypeOf entity Is SketchEllipse Or _
       TypeOf entity Is SketchSpline Or _
       TypeOf entity Is SketchOffsetSpline Then
        If TypeOf entity Is SketchSpline Or _
           TypeOf entity Is SketchOffsetSpline Then
            If entity.Closed Then
                curveIsClosed = True
            End If
        Else
            curveIsClosed = True
        End If
    End If
    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry 

    ' Determine if start point is at the min or max parameter.
    Dim startPoint As SketchPoint
    Dim endPoint As SketchPoint
    If Not curveIsClosed Then
        Dim startCoord() As Double
        Dim endCoord() As Double
        Call curveEval.GetEndPoints(startCoord, endCoord)
        If entity.StartSketchPoint.Geometry.IsEqualTo( _
          tg.CreatePoint2d(startCoord(0), startCoord(1))) Then
            Set startPoint = entity.StartSketchPoint
            Set endPoint = entity.EndSketchPoint
        Else
            Set endPoint = entity.StartSketchPoint
            Set startPoint = entity.EndSketchPoint
        End If
    End If 

    ' Get the curve length.
    Dim length As Double
    Call curveEval.GetLengthAtParam(minU, maxU, length) 

    ' Determine the length between segments.
    Dim offset As Double
    offset = length / segmentCount 

    ' Start a transaction to wrap the sketch creation as a
    ' single undo operation.
    On Error GoTo ErrorFound
    Dim transMgr As TransactionManager
    Set transMgr = ThisApplication.TransactionManager
    Dim trans As Transaction
    Set trans = transMgr.StartTransaction( _
                    ThisApplication.ActiveDocument, "Segment Curve") 

    ' Defer updates on the sketch while the sketch entities
    ' are being created.  This will significantly improve
    ' performance.
    sk.DeferUpdates = True 

    ' Calculate the points and create a sketch
    ' point at each position.
    Dim points() As SketchPoint
    ReDim points(segmentCount)
    Dim i As Integer
    Dim currentLength As Double
    currentLength = 0
    For i = 0 To segmentCount
        Dim currentParam As Double
        Call curveEval.GetParamAtLength(minU, currentLength, _
                                        currentParam)
        currentLength = currentLength + offset 

        Dim params(0) As Double
        params(0) = currentParam
        Dim coords() As Double
        Call curveEval.GetPointAtParam(params, coords) 

        If i = 0 Then
            ' Special case for first point.
            If Not curveIsClosed Then
                Set points(i) = startPoint
            Else
                Set points(i) = sk.SketchPoints.Add( _
                       tg.CreatePoint2d(coords(0), coords(1)), False)
                Set endPoint = points(i)
            End If
        ElseIf i = segmentCount Then
            ' Special case for last point
            Set points(i) = endPoint
        Else
            Set points(i) = sk.SketchPoints.Add( _
                       tg.CreatePoint2d(coords(0), coords(1)), False)
        End If
    Next 

    ' Connect the points with lines.
    For i = 0 To segmentCount - 1
        Call sk.SketchLines.AddByTwoPoints(points(i), points(i + 1))
    Next 

    ' Make the selected entity construction geometry.
    entity.Construction = True

    ' There's a current problem that when setting the construction
    ' property, the display isn't updated to reflect this change
    ' until something causes the sketch to recompute.  This performs
    ' a change on the sketch to kick a recompute.
    Dim originalPoint As Point2d
    Set originalPoint = points(0).Geometry
    Call points(0).MoveTo(tg.CreatePoint2d( _
                                   points(0).Geometry.X + 0.001, _
                                   points(0).Geometry.Y))
    Call points(0).MoveTo(originalPoint) 

    ' Turn off the defer to the sketch will recompute normally.
    sk.DeferUpdates = False 

    trans.End
    Exit Sub

ErrorFound:
    sk.DeferUpdates = False 

    If Not trans Is Nothing Then
        trans.Abort
    End If 

    MsgBox "Unexpected error segmenting curve."
End Sub