如何用vba来判断两直线是否相交?

milan_cs

如何用vba来判断两直线是否相交，若相交，得出交点坐标，


我是新手，望各位前辈多多指教，谢谢！


MAIL:gujian@sohbicn.com

efan2000

使用直线对象的IntersectWith方法，参看帮助。

2. Sub Example_IntersectWith()
3.        ' This example creates a line and circle and finds the points at
4.        ' which they intersect.
5.       
6.        ' Create the line
7.        Dim lineObj As AcadLine
8.        Dim startPt(0 To 2) As Double
9.        Dim endPt(0 To 2) As Double
10.        startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
11.        endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
12.        Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
13.                
14.        ' Create the circle
15.        Dim circleObj As AcadCircle
16.        Dim centerPt(0 To 2) As Double
17.        Dim radius As Double
18.        centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
19.        radius = 1
20.        Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
21.        ZoomAll
22.            
23.        ' Find the intersection points between the line and the circle
24.        Dim intPoints As Variant
25.        intPoints = lineObj.IntersectWith(circleObj, acExtendNone)
26.       
27.        ' Print all the intersection points
28.        Dim I As Integer, j As Integer, k As Integer
29.        Dim str As String
30.        If VarType(intPoints) <> vbEmpty Then
31.                For I = LBound(intPoints) To UBound(intPoints)
32.                        str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
33.                        MsgBox str, , "IntersectWith Example"
34.                        str = ""
35.                        I = I + 2
36.                        j = j + 3
37.                        k = k + 1
38.                Next
39.        End If
40. End Sub

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