求助：怎么求两条相交多段线的交点？

fengxue007

怎么求两条相交多段线的交点？谢谢！

robbin840311

请看VBA帮助中的IntersectWith方法。

语法如下：

Signature

RetVal = object.IntersectWith(IntersectObject, ExtendOption)

Object

MSITStore:C:\Program%20Files\Common%20Files\Autodesk%20Shared\ACADAUTO.CHM::/all_drawing_objects.htm">All Drawing Objects (Except Pviewport and PolygonMesh)
The object or objects this method applies to.

IntersectObject

Object, input-only;
The object can be one of MSITStore:C:\Program%20Files\Common%20Files\Autodesk%20Shared\ACADAUTO.CHM::/all_drawing_objects.htm">All Drawing Objects.

ExtendOption

AcExtendOption enum; input-only
This option specifies if none, one or both, of the objects are to be extended in order to attempt an intersection.

acExtendNone	Does not extend either object.
acExtendThisEntity	Extends the base object.
acExtendOtherEntity	Extends the object passed as an argument.
acExtendBoth	Extends both objects.

RetVal   这就是获取的交点坐标

Variant (array of doubles)
The array of points where one object intersects another object in the drawing

如VBA自带的例子：

Sub Example_IntersectWith()
    ' This example creates a line and circle and finds the points at
    ' which they intersect.
    
    ' Create the line
    Dim lineObj As AcadLine
    Dim startPt(0 To 2) As Double
    Dim endPt(0 To 2) As Double
    startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
    endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
        
    ' Create the circle
    Dim circleObj As AcadCircle
    Dim centerPt(0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
    radius = 1
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
    ZoomAll
      
    ' Find the intersection points between the line and the circle
    Dim intPoints As Variant
    intPoints = lineObj.IntersectWith(circleObj, acExtendNone)
    
    ' Print all the intersection points
    Dim I As Integer, j As Integer, k As Integer
    Dim str As String
    If VarType(intPoints) <> vbEmpty Then
        For I = LBound(intPoints) To UBound(intPoints)
            str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
            MsgBox str, , "IntersectWith Example"
            str = ""
            I = I + 2
            j = j + 3
            k = k + 1
        Next
    End If
End Sub

robbin840311

请查看VBA中的IntersectWith方法。