The Percona Live Open Source Database Conference Europe 2017 is the premier event for the diverse and active European open source database community, as well as businesses that develop and use open source database software.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Public Class Geometry
Public Enum SegmentIntersection
None = 0 ' The segments are parallel and will never intersect
Point = 1 ' The segments physically intersect in one point
ExtrapolatedPoint = 2 ' The segments would physically intersect in one point if one or both segments were extended
Overlapping = 3 ' The segments are parallel and overlap in a point or segment
End Enum
Public Shared Function SegmentIntersect( _
ByVal A As Point, ByVal B As Point, _
ByVal C As Point, ByVal D As Point, _
ByRef E As Point, ByRef F As Point) As SegmentIntersection
' If one or both of the segments passed in is actually a point then just do a PointToSegmentDistance() calculation:
If A.Equals(B) OrElse C.Equals(D) Then
If A.Equals(B) AndAlso C.Equals(D) Then
If A.Equals(C) Then
E = A
F = A
Return Geometry.SegmentIntersection.Point
Else
Return Geometry.SegmentIntersection.None
End If
ElseIf A.Equals(B) Then
If Geometry.PointToSegmentDistance(A.X, A.Y, C.X, C.Y, D.X, D.Y) = 0 Then
E = A
F = A
Return Geometry.SegmentIntersection.Point
End If
ElseIf C.Equals(D) Then
If Geometry.PointToSegmentDistance(C.X, C.Y, A.X, A.Y, B.X, B.Y) = 0 Then
E = C
F = C
Return Geometry.SegmentIntersection.Point
End If
End If
Return Geometry.SegmentIntersection.None
End If
' We have two actual segments...let's do the calculations for Det1 and Det2:
Dim Det1 As Double = (A.Y - C.Y) * (D.X - C.X) - (A.X - C.X) * (D.Y - C.Y)
Dim Det2 As Double = (B.X - A.X) * (D.Y - C.Y) - (B.Y - A.Y) * (D.X - C.X)
If Det2 <> 0 Then ' Non-Parallel Segments (they intersect or would intersect if extended)
Dim Det3 As Double = (A.Y - C.Y) * (B.X - A.X) - (A.X - C.X) * (B.Y - A.Y)
Dim Det4 As Double = (B.X - A.X) * (D.Y - C.Y) - (B.Y - A.Y) * (D.X - C.X)
Dim r As Double = Det1 / Det2
Dim s As Double = Det3 / Det4
' Compute the intersection point:
E.X = A.X + r * (B.X - A.X)
E.Y = A.Y + r * (B.Y - A.Y)
F = E
If (r >= 0 AndAlso r <= 1) AndAlso (s >= 0 AndAlso s <= 1) Then
' They physically intersect
Return Geometry.SegmentIntersection.Point
Else
' They would physically intersect if one or both segments were extended
Return Geometry.SegmentIntersection.ExtrapolatedPoint
End If
Else ' Parallel Segments
If Det1 <> 0 Then ' Non-Overlapping
Return Geometry.SegmentIntersection.None
Else ' Overlapping (one point or a segment)
' The parallel segments are the same
If (A.Equals(C) AndAlso B.Equals(D)) OrElse (A.Equals(D) AndAlso B.Equals(C)) Then
E = A
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
' The parallel segments overlap in exactly one point
If B.Equals(C) OrElse B.Equals(D) Then
E = B
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
If A.Equals(C) OrElse A.Equals(D) Then
E = A
F = A
Return Geometry.SegmentIntersection.Overlapping
End If
' The parallel segments are overlapping in a segment
If Geometry.SegmentContainsPoint(A, B, C) AndAlso Geometry.SegmentContainsPoint(C, D, B) Then
E = C
F = B
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(A, B, D) AndAlso Geometry.SegmentContainsPoint(D, C, B) Then
E = D
F = B
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(B, A, C) AndAlso Geometry.SegmentContainsPoint(C, D, A) Then
E = C
F = A
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(B, A, D) AndAlso Geometry.SegmentContainsPoint(D, C, A) Then
E = D
F = A
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(C, D, A) AndAlso Geometry.SegmentContainsPoint(A, B, D) Then
E = A
F = D
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(C, D, B) AndAlso Geometry.SegmentContainsPoint(B, A, D) Then
E = B
F = D
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(D, C, A) AndAlso Geometry.SegmentContainsPoint(A, B, C) Then
E = A
F = C
Return Geometry.SegmentIntersection.Overlapping
ElseIf Geometry.SegmentContainsPoint(D, C, B) AndAlso Geometry.SegmentContainsPoint(B, A, C) Then
E = B
F = C
Return Geometry.SegmentIntersection.Overlapping
End If
' One segment completely contains the other
If Geometry.SegmentContainsPoint(A, B, C) AndAlso Geometry.SegmentContainsPoint(A, B, D) Then
E = C
F = D
Return Geometry.SegmentIntersection.Overlapping
End If
If Geometry.SegmentContainsPoint(C, D, A) AndAlso Geometry.SegmentContainsPoint(C, D, B) Then
E = A
F = B
Return Geometry.SegmentIntersection.Overlapping
End If
' Segments are parallel but not touching
Return Geometry.SegmentIntersection.None
End If
End If
End Function
Public Shared Function PointToPointDistance(ByVal Ax As Single, _
ByVal Ay As Single, ByVal Bx As Single, ByVal By As Single) _
As Single
' PointToPointDist = SquareRoot((Bx - Ax)^2 + (By - Ay)^2)
Return Math.Sqrt((Bx - Ax) * (Bx - Ax) + (By - Ay) * (By - Ay))
End Function
Public Shared Function PointToSegmentDistance( _
ByVal Px As Single, ByVal Py As Single, _
ByVal Ax As Single, ByVal Ay As Single, _
ByVal Bx As Single, ByVal By As Single) As Single
Dim q As Single
If (Ax = Bx) And (Ay = By) Then
' A and B passed in define a point, not a line.
' Point to Point Distance
Return PointToPointDistance(Px, Py, Ax, Ay)
Else
' Distance is the length of the line needed to connect the point to
' the(segment)such that the two lines would be perpendicular.
' q is the parameterized value needed to get to the intersection
q = ((Px - Ax) * (Bx - Ax) + (Py - Ay) * (By - Ay)) / _
((Bx - Ax) * (Bx - Ax) + (By - Ay) * (By - Ay))
' Limit q to 0 <= q <= 1
' If q is outside this range then the Point is somewhere past the
' endpoints of our segment. By setting q = 0 or q = 1 we are
' measuring the actual distacne from the point to one of the
' endpoints(instead)
If q < 0 Then q = 0
If q > 1 Then q = 1
' Distance
Return PointToPointDistance( _
Px, Py, (1 - q) * Ax + q * Bx, (1 - q) * Ay + q * By)
End If
End Function
Public Shared Function SegmentContainsPoint( _
ByVal A As Point, ByVal B As Point, ByVal C As Point) As Boolean
' Two Segments AB and CD have already been determined to have the
' same slope and that they overlap.
' AB is the segment, and C is the point in question.
' If AB contains C then return true, otherwise return false
If C.Equals(A) Or C.Equals(B) Then
Return True
ElseIf A.X = B.X Then ' Project to the Y-Axis for vertical lines
Dim minY As Integer = Math.Min(A.Y, B.Y)
Dim maxY As Integer = Math.Max(A.Y, B.Y)
If minY <= C.Y AndAlso C.Y <= maxY Then
Return True
Else
Return False
End If
Else ' Project to the X-Axis for anything else
Dim minX As Integer = Math.Min(A.X, B.X)
Dim maxX As Integer = Math.Max(A.X, B.X)
If minX <= C.X AndAlso C.X <= maxX Then
Return True
Else
Return False
End If
End If
End Function
End Class
'Take values from text-boxes
X1 = Val(Text1.Text)
Y1 = Val(Text2.Text)
X2 = Val(Text3.Text)
Y2 = Val(Text4.Text)
X3 = Val(Text5.Text)
y3 = Val(Text6.Text)
X4 = Val(Text7.Text)
y4 = Val(Text8.Text)
'Intermediate variables
a = Y1 - Y2
b = X2 - X1
c = X2 * Y1 - X1 * Y2
d = y3 - y4
e = X4 - X3
f = X4 * y3 - X3 * y4
denom = (a * e - b * d)
'Get the point of intersection
If denom <> 0 Then
x = (c * e - b * f) / denom
y = (a * f - c * d) / denom
Else
Text9.Text = "Lines do not intersect"
End If
'Find out if the point lies in the segment
Text9.Text = "x = " & Format$(x, "#.###") & " y = " & Format$(y, "#.###")
If Not (((x > X1) And (x < X2)) Or ((x < X1) And (x > X2))) Then
Text9.Text = Text9.Text & " : Line1 needs to be extended"
End If
If Not (((x > X3) And (x < X4)) Or ((x < X3) And (x > X4))) Then
Text9.Text = Text9.Text & " : Line2 needs to be extended"
End If
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.