急求一段VB代码：空间两直线的距离或交点

Option Explicit



Private Type Point

    X As Double

    Y As Double

End Type



Private Type Lines

    P1 As Point

    P2 As Point

End Type



Const CROSS As Long = 0     '两直线相交

Const COLINE As Long = 1    '两直线重合

Const PARALLEL As Long = 2  '两直线平行



'判断与计算交点

Private Function GetPoint(L1 As Lines, L2 As Lines, P As Point) As Long

    Dim A1 As Double, B1 As Double, C1 As Double

    Dim A2 As Double, B2 As Double, C2 As Double

    Dim D As Double, R As Double

    

    A1 = L1.P2.Y - L1.P1.Y

    B1 = L1.P1.X - L1.P2.X

    C1 = L1.P2.X * L1.P1.Y - L1.P1.X * L1.P2.Y

    

    A2 = L2.P2.Y - L2.P1.Y

    B2 = L2.P1.X - L2.P2.X

    C2 = L2.P2.X * L2.P1.Y - L2.P1.X * L2.P2.Y



    D = A1 * B2 - A2 * B1

    If D = 0 Then

        If (B1 * C2 <> B2 * C1) Or (A1 * C2 <> A2 * C1) Then

            GetPoint = PARALLEL    '平行

        Else

            GetPoint = COLINE      '重合

        End If

    Else

        '返回交点

        P.X = (A1 * C2 - A2 * C1) / D

        P.Y = (C1 * B2 - C2 * B1) / D

        Print P.X; P.Y

        GetPoint = CROSS           '相交

    End If

End Function



Private Function GetLine( _

    ByVal X1 As Double, _

    ByVal Y1 As Double, _

    ByVal X2 As Double, _

    ByVal Y2 As Double _

) As Lines

    Dim L As Lines

    With L

        .P1.X = X1

        .P1.Y = Y1

        .P2.X = X2

        .P2.Y = Y2

        Line (.P1.X, .P1.Y)-(.P2.X, .P2.Y)

    End With

    GetLine = L

End Function



'测试：

Private Sub Command1_Click()

    Dim L1 As Lines, L2 As Lines

    Dim P As Point

    Dim n As Long

    

    Me.Scale (-50, 30)-(50, -30)

    

    Me.Cls

    L1 = GetLine(-20, 20, 40, -40)

    L2 = GetLine(-10, 10, 20, -20)

    n = GetPoint(L1, L2, P)

    MsgBox Choose(n + 1, "相交", "重合", "平行")

    

    Me.Cls

    L1 = GetLine(-10, 10, 20, -30)

    L2 = GetLine(-10, 10, 20, -20)

    n = GetPoint(L1, L2, P)

    MsgBox Choose(n + 1, "相交", "重合", "平行")

    

    Me.Cls

    L1 = GetLine(-10, 20, 20, -10)

    L2 = GetLine(-10, 10, 20, -20)

    n = GetPoint(L1, L2, P)

    MsgBox Choose(n + 1, "相交", "重合", "平行")

    

End Sub