获取三维线条的笔画 - Inventor 2013新功能

原文地址： http://modthemachine.typepad.com/my_weblog/2012/05/get-strokes-for-2d-and-3d-transient-wireframe-geometry.html

本文由我的同事Wayne撰写。其中提到2013提供了直接的方法。

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

首先提到，这种需求源于要对草图的曲线进行拟合。也提及2013提供了直接的方法。 

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.

这里是一个简单的VBA代码。你需要先创建一个三维的草图，然后画个螺旋线。当执行VBA宏Approximate3DSketchGeometry ，会让你选择三维的曲线，并弹出对话框让你设置拟合线的高度容差。这个值作为最大绝对偏差，即拟合线离曲线本身能有多远。本例中使用0.25，基于API内部使用的单位（厘米）。拟合线将用Client Graphics绘制。

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:

还有个对话框让你决定是否使用现有的Client Graphics。图中所示的蓝色线条就是Client Graphics。

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. 
    ’ 创建Client Graphics. 如果已经有了，
    ‘让用户决定是否更新现有的，或创建一个新的
    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 
    

      ' 设置Clieng Graphics需要的坐标点集合. 
    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. 
    ’绘制线条LineStripGraphics ，
    Dim lineStrip As LineStripGraphics 
    Set lineStrip = node.AddLineStripGraphics 
    lineStrip.CoordinateSet = coordSet 
    
    ThisApplication.ActiveView.Update 
End Sub