Get strokes for 2d and 3d transient wireframe geometry

An enhancement in the Inventor 2013 API allows you to get strokes for 2d and 3d transient geometry. One reason why you may want to do this is to approximate sketch geometry. The new method is GetStrokes of the CurveEvaluator and Curve2dEvaluator objects. To get the transient geometry (CurveEvaluator) from the sketch entity, use the Geometry.Evaluator property.

New 2013 method used to get strokes

• CurveEvaluator.GetStrokes
• Curve2dEvaluator.GetStrokes

VBA Example:

Please keep in mind that we only recommend using VBA for prototyping and learning the API but do not recommend using VBA in production.

To try out this example create a 3D Sketch. I used a helical curve as you can see in the screenshot. When you run the Approximate3DSketchGeometry procedure it prompts you to select a 3d entity and then displays an InputBox asking for the chord height tolerance. This value will be used as the maximum of deviation. (How far off can these line segments be to the curve). I used .25. This will be centimeters in database units.

A MsgBox is used to ask if you want to use existing client graphics, create new client graphics or just cancel. The lines that you see that approximate the curve, are drawn using client graphics. Here is the result after running the procedure:

VBA Code:

' Draws client graphics that is an approximation
' of the selected curve.
' To use this have a part open that contains
' a 3D skech that contains curves.
Public Sub Approximate3DSketchGeometry()
    Dim partDoc As PartDocument
    Set partDoc = _
              ThisApplication.ActiveDocument
   
   ' Have the user select a sketch entity.
    Dim selectObj As SketchEntity3D
    Set selectObj = ThisApplication. _
                    CommandManager.Pick _
                    (kSketch3DCurveFilter, _
                    "Select 3D sketch entity")
    If selectObj Is Nothing Then
        On Error Resume Next
        Call partDoc.ComponentDefinition _
        .ClientGraphicsCollection.Item _
                                ("Test").Delete
        Call partDoc.GraphicsDataSetsCollection _
                             .Item("Test").Delete
        ThisApplication.ActiveView.Update
        Exit Sub
    End If
   
   ' Get the tolerance to approximate with.
    Dim tolerance As Double
    tolerance = Val(InputBox _
     ("Enter the chord height tolerance:", _
                       "Tolerance", "0.25"))
   
   ' Get the evaluator from the curve.
    Dim eval As CurveEvaluator
    Set eval = selectObj.Geometry.Evaluator
   
   ' Get the parameter extents.
    Dim startParam As Double
    Dim endParam As Double
    Call eval.GetParamExtents _
                        (startParam, endParam)
   
    Dim vertexCount As Long
    Dim vertexCoords() As Double
    Call eval.GetStrokes(startParam, endParam, _
            tolerance, vertexCount, vertexCoords)
   
    ' Create a client graphics object.
    ' If one already exists, give the user
    ' the option of re-using it, or creating
    ' a new one.
    Dim graphics As ClientGraphics
    Dim graphicsData As GraphicsDataSets
    On Error Resume Next
    Set graphics = partDoc.ComponentDefinition. _
            ClientGraphicsCollection.Item("Test")
    On Error GoTo 0
    If graphics Is Nothing Then
        Set graphics = partDoc. _
      ComponentDefinition.ClientGraphicsCollection _
                                      .Add("Test")
        Set graphicsData = partDoc. _
           GraphicsDataSetsCollection.Add("Test")
    Else
        Dim answer As VbMsgBoxResult
        answer = MsgBox _
        ("Yes = existing. No = new Cancel. = quit.", _
                         vbYesNoCancel + vbQuestion)
        If answer = vbNo Then
            On Error Resume Next
            graphics.Delete
            partDoc.GraphicsDataSetsCollection _
                              .Item("Test").Delete
            On Error GoTo 0
           
            Set graphics = partDoc.ComponentDefinition _
                  .ClientGraphicsCollection.Add("Test")
            Set graphicsData = partDoc. _
                  GraphicsDataSetsCollection.Add("Test")
        ElseIf answer = vbYes Then
            Set graphicsData = partDoc. _
                GraphicsDataSetsCollection.Item("Test")
        ElseIf answer = vbCancel Then
            If Not graphics Is Nothing Then
                graphics.Delete
                partDoc.GraphicsDataSetsCollection _
                                .Item("Test").Delete
                ThisApplication.ActiveView.Update
                Exit Sub
            End If
        End If
    End If
   
    Dim coordSet As GraphicsCoordinateSet
    Set coordSet = graphicsData.CreateCoordinateSet(1)
    Call coordSet.PutCoordinates(vertexCoords)

   ' Create a graphics node.
    Dim node As GraphicsNode
    Set node = graphics.AddNode(1)
   
    ' Create a line strip using the calculated coordinates.
    Dim lineStrip As LineStripGraphics
    Set lineStrip = node.AddLineStripGraphics
    lineStrip.CoordinateSet = coordSet
   
    ThisApplication.ActiveView.Update
End Sub

-Wayne