[Visual Basic 6.0] 兩線段判斷是否相交與求其交點座標 (特殊解法)

2013-11-14

摘要:[Visual Basic 6.0] 兩線段判斷是否相交與求其交點座標 (特殊解法)

正在來講，解 A - B 與 C - D 兩線段是否相交與求其交點座標都是需要

(1) 分別求出 A - B 與 C - D 的方程式

(2) 解聯立求交點座標

(3) 代交點座標判斷是否介於 A - B 與 C - D 兩線段上 ( 介於則為交點不介於則不為交點 )

A - B 兩點方程式該怎麼求 (?)

正常做法：

=> 求 M (斜率) 然後 Y - Y1 = M ( X- X1 )

例子：A(1,1) - B(5,5) 線段方程式

M = (Y2-Y1) / (X2-X1)

=> (5-1) / (5-1) 得到 M = 1

方程式為： (Y-5) = 1 * (X-1)

經過轉換得 X-Y+4 = 0

但程式在轉換的過程通常都是比較麻煩的！

特殊解法：

設 A-B 線段為 aX+bY=c , C-D 線段為 dX+eY=f


    ' A-B 方程式
    a = a2(1) - a1(1) ' Y 相剪 ( 左-右 )
    b = a1(0) - a2(0) ' X 相剪 ( 右-左 )
    c = a * a1(0) + b * a1(1) ' 代入一組
    ' C-D 方程式
    d = b2(1) - b1(1) ' Y 相剪 ( 左-右 )
    e = b1(0) - b2(0) ' X 相剪 ( 右-左 )
    f = d * b1(0) + e * b1(1) ' 代入一組

我們假設交點為 (N,O) 則方程式解法為：


    N = (c * e - b * f) / (a * e - b * d) ' 解方程式
    O = (c * d - a * f) / (b * d - a * e) ' 解方程式

最後我們該判斷是否在兩線段上：


    S = True ' 判斷交點是否皆介於 A-B C-D 點中
    
    ' 比較 A - B 點 X 軸大小
    If Val(A1(0)) > Val(a2(0)) Then Mx = Val(A1(0)): Sx = Val(a2(0)) Else Sx = Val(A1(0)): Mx = Val(a2(0))
    ' 比較 A - B 點 Y 軸大小
    If Val(A1(1)) > Val(a2(1)) Then MY = Val(A1(1)): SY = Val(a2(1)) Else SY = Val(A1(1)): MY = Val(a2(1))
    ' 判斷是否在 A - B 點上
    If N >= Sx And N <= Mx And O >= SY And O <= MY Then S = True Else S = False

    ' 比較 C - D 點 X 軸大小
    If Val(B1(0)) > Val(B2(0)) Then Mx = Val(B1(0)): Sx = Val(B2(0)) Else Sx = Val(B1(0)): Mx = Val(B2(0))
    ' 比較 C - D 點 Y 軸大小
    If Val(B1(1)) > Val(B2(1)) Then MY = Val(B1(1)): SY = Val(B2(1)) Else SY = Val(B1(1)): MY = Val(B2(1))
    ' 判斷是否在 C - D 點上
    If N >= Sx And N <= Mx And O >= SY And O <= MY And S = True Then S = True Else S = False

    If S Then
        Text5.Text = "有相交"
        Text6.Text = Format(N, "0.00") & "," & Format(O, "0.00")
    Else
        Text5.Text = "無相交"
        Text6.Text = ""
    End If

最後程式執行畫面：


Private Sub Command1_Click()
    Picture1.Cls
    Picture1.Scale (-40, 40)-(40, -40)
        Picture1.Line (-40, 0)-(40, 0)
        Picture1.Line (0, 40)-(0, -40)
    For i = -40 To 40 Step 10
        Picture1.Circle (i, 0), 0.5: Picture1.Print i
        Picture1.Circle (0, i), 0.5: Picture1.Print i
    Next i
    
    A1 = Split(Text1, ",") ' A
    a2 = Split(Text2, ",") ' B
    B1 = Split(Text3, ",") ' C
    B2 = Split(Text4, ",") ' D
    
    ' 繪製
    Picture1.Line (A1(0), A1(1))-(a2(0), a2(1)) ' A-B 的直線
    Picture1.Line (B1(0), B1(1))-(B2(0), B2(1)) ' C-D 的直線
    ' A-B 方程式
    a = a2(1) - A1(1) ' Y 相剪 ( 左-右 )
    b = A1(0) - a2(0) ' X 相剪 ( 右-左 )
    c = a * A1(0) + b * A1(1) ' 代入一組
    ' C-D 方程式
    d = B2(1) - B1(1) ' Y 相剪 ( 左-右 )
    e = B1(0) - B2(0) ' X 相剪 ( 右-左 )
    f = d * B1(0) + e * B1(1) ' 代入一組
    
    N = (c * e - b * f) / (a * e - b * d) ' 解方程式
    O = (c * d - a * f) / (b * d - a * e) ' 解方程式
    
    S = True ' 判斷交點是否皆介於 A-B C-D 點中
    
    ' 比較 A - B 點 X 軸大小
    If Val(A1(0)) > Val(a2(0)) Then Mx = Val(A1(0)): Sx = Val(a2(0)) Else Sx = Val(A1(0)): Mx = Val(a2(0))
    ' 比較 A - B 點 Y 軸大小
    If Val(A1(1)) > Val(a2(1)) Then MY = Val(A1(1)): SY = Val(a2(1)) Else SY = Val(A1(1)): MY = Val(a2(1))
    ' 判斷是否在 A - B 點上
    If N >= Sx And N <= Mx And O >= SY And O <= MY Then S = True Else S = False

    ' 比較 C - D 點 X 軸大小
    If Val(B1(0)) > Val(B2(0)) Then Mx = Val(B1(0)): Sx = Val(B2(0)) Else Sx = Val(B1(0)): Mx = Val(B2(0))
    ' 比較 C - D 點 Y 軸大小
    If Val(B1(1)) > Val(B2(1)) Then MY = Val(B1(1)): SY = Val(B2(1)) Else SY = Val(B1(1)): MY = Val(B2(1))
    ' 判斷是否在 C - D 點上
    If N >= Sx And N <= Mx And O >= SY And O <= MY And S = True Then S = True Else S = False

    If S Then
        Text5.Text = "有相交"
        Text6.Text = Format(N, "0.00") & "," & Format(O, "0.00")
    Else
        Text5.Text = "無相交"
        Text6.Text = ""
    End If
End Sub

Private Sub Command2_Click()
    Picture1.Cls ' 清空
End Sub

[Visual Basic 6.0] 兩線段判斷是否相交與求其交點座標 (特殊解法).rar

#0xDe 從分享中學習

#Facebook：ProgrammerDe (https://www.facebook.com/MicrosoftDes) 有問題歡迎提問

回首頁