Make Your Microsoft Dynamics Investment Count & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.
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.