This code finds where two lines intersect just by giving this function two X and Y coordinates on the two lines.
<i>If you plan to use this code in some application, take a look at how the code handles two lines that don't cross(parallel), and when you give it the same line. Also the code can't handle vertical lines.</i>
/html>
'*****
'Nick Avery
'[email protected]
'Updated 14, April, 2002
'*****
Private Type TDLine
X As Double
Y As Double
X2 As Double
Y2 As Double
End Type
Private Type TDPoint
X As Double
Y As Double
End Type
Private Function LinesCross(Line1 As TDLine, Line2 As TDLine) As TDPoint
Dim Slope1 As Double
Dim Slope2 As Double
Dim YInt1 As Double
Dim YInt2 As Double
'Get the slopes
If (Line1.X2 - Line1.X) <> 0 Then
Slope1 = (Line1.Y2 - Line1.Y) / (Line1.X2 - Line1.X)
Else 'The slope is undefined
If (Line2.X2 - Line2.X) = 0 Then 'Both the lines are vertical and don't cross
LinesCross.X = 0
LinesCross.Y = 0
Else
'Get Slope2 and YInt2
Slope2 = (Line2.Y2 - Line2.Y) / (Line2.X2 - Line2.X)
YInt2 = (Slope2 * Line2.X - Line2.Y) * -1
'Claculate X and Y
LinesCross.X = Line1.X
LinesCross.Y = Slope2 * Line1.X - (Slope2 * Line2.X - Line2.Y)
End If
Exit Function
End If
If (Line2.X2 - Line2.X) <> 0 Then
Slope2 = (Line2.Y2 - Line2.Y) / (Line2.X2 - Line2.X)
Else 'The slope is undefined
'Claculate X and Y
LinesCross.X = Line2.X
LinesCross.Y = Slope1 * Line2.X - (Slope1 * Line1.X - Line1.Y)
Exit Function
End If
'Get the Y intercepts
YInt1 = -(Slope1 * Line1.X - Line1.Y)
YInt2 = -(Slope2 * Line2.X - Line2.Y)
'-B = M * X -Y
'Check if the lines cross
If Slope1 = Slope2 And YInt1 <> YInt2 Then 'The lines are parallel and don't cross
LinesCross.X = 0
LinesCross.Y = 0
ElseIf Round(Slope1, 2) = Round(Slope2, 2) And YInt1 = YInt2 Then 'It is the same line and they cross at every point on that line
LinesCross.X = Line1.X
LinesCross.Y = Line1.Y
Else 'The lines cross some ware
If Slope1 = 0 Then 'Line one is horizontal
LinesCross.Y = Line1.Y
LinesCross.X = (YInt2 - Line1.Y) / Slope2
ElseIf Slope2 = 0 Then 'Line two is horizontal
LinesCross.Y = Line2.Y
LinesCross.X = (YInt2 - Line2.Y) / Slope1
Else
LinesCross.Y = (YInt1 * (Slope2 / Slope1) - YInt2) / ((Slope2 / Slope1) - 1)
LinesCross.X = (LinesCross.Y - YInt1) / Slope1
End If
End If
End Function
Private Sub Form_Load()
Dim Line1 As TDLine
Dim Line2 As TDLine
Dim Point As TDPoint
Me.AutoRedraw = True
Me.Scale (-50, 50)-(50, -50)
Line1.X = -90
Line1.Y = 25
Line1.X2 = 35
Line1.Y2 = 15
Line2.X = 25
Line2.Y = 5
Line2.X2 = -16
Line2.Y2 = 45
Point = LinesCross(Line1, Line2)
Me.Line (Line1.X, Line1.Y)-(Line1.X2, Line1.Y2)
Me.Line (Line2.X, Line2.Y)-(Line2.X2, Line2.Y2)
Me.Circle (Point.X, Point.Y), 5
End Sub
Intersecting Lines
By Nick Avery, published on 15 Apr 2002
| Filed in
You might also like...
VB 6 forum discussion
-
CorelDRAW VBA: cdrTraceLineDrawing FAILS, producing single linear path instead of Centerline trace?
by dancemanj (0 replies)
-
client/server application using activex
by beautifulheart (0 replies)
-
System Error &H8007007E. The specifed module could not be found.
by swiftsafe (5 replies)
-
Invitation to take part in an academic research study
by researchlab (0 replies)
-
Send SMS with SMPP
by mmahmoud (0 replies)
VB 6 podcasts
-
Stack Overflow Podcast: Podcast #45 – Keeping it Sharp
Published 7 years ago, running time 0h54m
Our guest this week is Eric Lippert – language architect extraordinaire and famous for all his work at Microsoft in developing their languages Eric joined Microsoft right out of college and was originally working on VB It’s time for everyone’s favorite game: Name the Worst Feature of that Microso.
Comments