草图直线做延伸（Extend）初探

在 http://blog.youkuaiyun.com/autodeskinventorapi/article/details/17678983 文中提到，目前API没有关于草图实体剪裁，延伸，打断等具体方法，因此，只能摸索Inventor的功能，自行设计出算法。本文探讨延伸（Extend）。

如果你手动操作，会发现延伸有很多种情况，即便是对最简单的直线进行延伸。我能发现的规律是，Inventor首先判断你拾取直线时靠近起点还是终点，如果是起点，则沿着起点的延伸方向，看直线会和哪个草图实体做实质性的相交。所谓实质性相交指的是延长线的确和草图实体有交点，而不是和其延生部分有交点。如下图1，直线1的将和圆弧有实质性相交。

而如果没有找到实质性的相交，则看是否和草图直线（注意只有草图直线）有延长部分的相交。如图2，直线1将和直线2延长部分相交。

若找到可用相交，则将起点延长到对应交点。如果没有，则看终点是否有可用的相交，则将终点延长到对应交点。即使是靠近起点拾取直线！！

如果都没有，则什么都不做。

图1：

图2：

可以想象，虽然理论上是能够用API现有的方法实现，但这个算法是比较复杂的。

所以可以考虑退而求其次，将可能的流程简化。我相信大部分流程都应该清晰的知道想和哪条草图实体做延伸。不就需要延伸直线么。那何必还在和哪条草图实体相交而发愁？

只需要对需要延生的直线和延伸到的实体做相交分析，最后将起点或重点延伸于此即可。以下是个简短的代码，考虑了三种可能情况：直线延伸到直线，直线延伸到圆弧，直线延伸到样条。

Sub extendSketchLine()

Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument

Dim oDef As PartComponentDefinition
Set oDef = oPartDoc.ComponentDefinition

Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry

Dim oSketch As Sketch
Set oSketch = oDef.Sketches(1)

Dim oBaseSketchLine As SketchLine
Set oBaseSketchLine = oSketch.SketchLines(1)

Dim oBaseLineVec As UnitVector2d
Set oBaseLineVec = oBaseSketchLine.Geometry.StartPoint.VectorTo(oBaseSketchLine.Geometry.EndPoint).AsUnitVector()

Dim oBaseSketchLineGem As Line2d
Set oBaseSketchLineGem = oTG.CreateLine2d(oBaseSketchLine.Geometry.StartPoint, oBaseLineVec)

'store the intersect points
Dim oObjColl As ObjectsEnumerator

'***********
'if extend to a sketch line
' the sketch line is line segment. but sketch line can extend to the virtual point of the other line segment
'so build a line2d object firstly
Dim oToSketchLine As SketchLine
Set oToSketchLine = oSketch.SketchLines(2)

Dim oToLineVec As UnitVector2d
Set oToLineVec = oToSketchLine.Geometry.StartPoint.VectorTo(oToSketchLine.Geometry.EndPoint).AsUnitVector()

Dim oToSketchLineGem As Line2d
Set oToSketchLineGem = oTG.CreateLine2d(oToSketchLine.Geometry.StartPoint, oToLineVec)

Set oObjColl = oBaseSketchLineGem.IntersectWithCurve(oToSketchLineGem)
'***************

'***********
'if extend to a sketch arc
'Dim oToSketchArc As SketchArc
'Set oToSketchArc = oSketch.SketchArcs(1)
'
'Dim oToSketchArcGem As Arc2d
'Set oToSketchArcGem = oToSketchArc.Geometry
'
'Set oObjColl = oBaseSketchLineGem.IntersectWithCurve(oToSketchArcGem)

'***************

'***********
'if extend to a sketch spline
'Dim oToSketchSpline As SketchSpline
'Set oToSketchSpline = oSketch.SketchSplines(1)
'
'Dim oToSketchSplineGem As BSplineCurve2d
'Set oToSketchSplineGem = oToSketchSpline.Geometry
'
'Set oObjColl = oBaseSketchLineGem.IntersectWithCurve(oToSketchSplineGem)
'***************



If oObjColl.Count > 0 Then
    
    Dim oInterPt As Point2d
    Set oInterPt = oObjColl(1)
    
    'check start point or end point is near to the intersect point
    If oBaseSketchLine.Geometry.StartPoint.VectorTo(oInterPt).Length < _
     oBaseSketchLine.Geometry.EndPoint.VectorTo(oInterPt).Length Then
     'extend the start point
      Call oBaseSketchLine.StartSketchPoint.MoveTo(oInterPt)
    Else
      'extend the end point
      Call oBaseSketchLine.EndSketchPoint.MoveTo(oInterPt)
    End If
Else

  MsgBox "line1 cannot extend to the other object!"
End If

 
End Sub