求任意两线交点
我用Line方法编了一个画线的程序,不是直线的,现在要求任意两线交点,怎么编这个程序?
[解决办法]
数学都忘光了,翻书看了大半天,弄了一个好象是对的,思路就是解方程,然后判断这样吧:
Option ExplicitPrivate Type Point X As Double Y As DoubleEnd TypePrivate Type Lines P1 As Point P2 As PointEnd TypeConst 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 = A2 * B1 - A1 * B2 'Debug.Print A1; B1; A2; B2; C1; C2 If D = 0 Then If (A1 = A2) And (B1 = B2) Then GetPoint = COLINE Else GetPoint = PARALLEL End If Else P.X = (C1 * B2 - C2 * B1) / D P.Y = (A1 * C2 - A2 * C1) / D GetPoint = CROSS End IfEnd Function'测试Private Sub Command1_Click() Dim L1 As Lines, L2 As Lines Dim Pot As Point Dim R As Long With L1 .P1.X = -10 .P1.Y = -10 .P2.X = 20 .P2.Y = 20 End With With L2 .P1.X = 10 .P1.Y = 10 .P2.X = -20 .P2.Y = 20 End With 'PLine L1 'PLine L2 R = GetPoint(L1, L2, Pot) If R = CROSS Then MsgBox "X: " & Pot.X & " Y: " & Pot.Y Else MsgBox Choose(R, "共线", "平行") End IfEnd Sub