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