11-21-2024, 10:13 PM
(11-21-2024, 06:52 PM)madscijr Wrote:(11-01-2023, 01:20 PM)bplus Wrote: Good stuff! let me know if you want exact point (coordinates) of intersect, though my code is a little longerI could use that...
WTH? I lost all the reply I was working on.
Here's the code, forget the intro:
Code: (Select All)
_Title "Segments Intersect revised 2020-03-16: White Circles are Intersects White Lines are Overlaps" 'b+ 2020-03-16
' Just worked Rosetta Code for Line Intersect Line
' but what if we want to know if two line segments intersect?
'2020-03-14 "Two Line Segments Intersect" 'b+ 2020-03-14 start
'2020-03-15 rework this code so we identify points all on same line and
' if there is overlap of line segments say the two x endpoints of the segments
' otherwise, if there is an intersect of 2 line segments say the point x, y.
' Return 0 no intersect or overlap
' Return 1 if intersect and ix, iy point of intersect
' Return -1 if segments are on same and there is overlap: ix = overlap start x, iy overlap end x
'2020-03-16 "Segments Intersect mod tester" >>> just post testing code
'mod tester for 2 segments of vertical line and found I need to add more parameters to
' FUNCTION twoLineSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
' mod that name and parameters to:
' FUNCTION twoSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix1, iy1, ix2, iy2)
'2020-03-16 Segments Intersect revised 2020-03-16
' OK now get the new FUNCTION working
' ah! I had to tighten down D from >.2 to >.05 but loosen y-axis intersect
Const xmax = 1200, ymax = 700
Screen _NewImage(xmax, ymax, 32)
_Delay .25
_ScreenMove _Middle
Dim ax1 As Integer, ax2 As Integer, ay1 As Integer, ay2 As Integer
Dim bx1 As Integer, bx2 As Integer, by1 As Integer, by2 As Integer
Do
restartA:
Cls
If Rnd < .3 Then 'throw in some vertical lines
Locate 3, 80: Print "Red Points are vertical."
ax1 = (xmax - 20) * Rnd + 10: ay1 = (ymax - 60) * Rnd + 50
ax2 = ax1: ay2 = (ymax - 60) * Rnd + 50
Else
Locate 3, 80: Print "Red Points are Random."
ax1 = (xmax - 20) * Rnd + 10: ay1 = (ymax - 60) * Rnd + 50
ax2 = (xmax - 20) * Rnd + 10: ay2 = (ymax - 60) * Rnd + 50
End If
If _Hypot(ax1 - ax2, ay1 - ay2) < 50 Then GoTo restartA
If Rnd < .6 Then 'get some points on same line
Locate 3, 80: Print "Blue Points are on same line as Red."
slopeYintersect ax1, ay1, ax2, ay2, slope1, Yintercept1
bx1 = (xmax - 20) * Rnd + 10: by1 = bx1 * slope1 + Yintercept1
bx2 = (xmax - 20) * Rnd + 10: by2 = bx2 * slope1 + Yintercept1
Else
If Rnd < .4 Then 'throw in some verticals, we already have a doing verticals
Locate 3, 80: Print Space$(50)
Locate 3, 80: Print "All points vertical."
ax1 = (xmax - 20) * Rnd + 10: ax2 = ax1: bx1 = ax1: bx2 = ax1
ay1 = 50 + Rnd * 50: ay2 = ay1 + 50 + Rnd * 50
by1 = ay1 + 25 + Rnd * 50: by2 = by1 + 50 + (Rnd * ymax - 60 - by1)
by1 = (ymax - 60) * Rnd + 50: bx2 = bx1: by2 = (ymax - 60) * Rnd + 50
Else
Locate 4, 80: Print "Blue Points are Random."
bx1 = (xmax - 20) * Rnd + 10: by1 = (ymax - 60) * Rnd + 50
bx2 = (xmax - 20) * Rnd + 10: by2 = (ymax - 60) * Rnd + 50
End If
End If
If bx1 < 10 Or bx1 > xmax - 10 Then GoTo restartA
If bx2 < 10 Or bx2 > xmax - 10 Then GoTo restartA
If by1 < 50 Or by1 > ymax - 10 Then GoTo restartA
If by2 < 50 Or by2 > ymax - 10 Then GoTo restartA
If _Hypot(bx1 - bx2, by1 - by2) < 30 Then GoTo restartA
Line (ax1, ay1)-(ax2, ay2), &HFFFF0000
Circle (ax1, ay1), 4, &HFFFF0000
Circle (ax2, ay2), 4, &HFFFF0000
Line (bx1, by1)-(bx2, by2), &HFF0000FF
Circle (bx1, by1), 4, &HFF0000FF
Circle (bx2, by2), 4, &HFF0000FF
Locate 1, 1
PRINT "Segments ("; ts$(ax1); ", "; ts$(ay1); ") ("; ts$(ax2); ", ";_
ts$(ay2); ") and ("; ts$(bx1); ", "; ts$(by1); ") ("; ts$(bx2); ", "; ts$(by2); ")"
' Plug in your 2 Segment Intersect SUB or FUNCTION Here
' and interpret reults: yellow circle around intersect point
' and an alpha shaded box where two co-linear segments overlap
'=====================================================================================================
intersect = twoSegmentsIntersect%(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix1, iy1, ix2, iy2)
If intersect = -1 Then 'segments overlap on same line
Print " Segments overlap between: ("; ts$(ix1); ", "; ts$(iy1); ") and ("; ts$(ix2); ", "; ts$(iy2); ")"
Line (ix1, iy1)-(ix2, iy2), &HFFFFFFFF
ElseIf intersect = 1 Then 'segments intersect at one point
Print " Segments intersect: ("; ts$(ix1); ", "; ts$(iy1); ")"
Circle (ix1, iy1), 3, &HFFFFFFFF
ElseIf intersect = 0 Then 'segments do not intersect nor overlap
Print " Segments do not Intersect or Overlap."
End If
'=====================================================================================================
Input "Press enter for another demo, any + enter to quit...", again$
Cls
Loop Until Len(again$)
'Slope and Y-intersect for non vertical lines,
' if x1 = x2 the line is vertical don't call this sub
' because slope calculation would cause division by 0 error.
Sub slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) 'check x1 <> x2 first!
slope = (Y2 - Y1) / (X2 - X1): Yintercept = slope * (0 - X1) + Y1
End Sub
Function ts$ (n)
ts$ = _Trim$(Str$(Int(100 * n) / 100))
End Function
' ======================================== end tester code functions ======================================
'This function needs: FUNCTION lineIntersectLine% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
' which in turn needs: SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) 'check x1 <> x2 first!
Function twoSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix1, iy1, ix2, iy2)
intersect = lineIntersectLine%(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
If ax1 < ax2 Then aMinX = ax1: aMaxX = ax2 Else aMinX = ax2: aMaxX = ax1
If ay1 < ay2 Then aMinY = ay1: aMaxY = ay2 Else aMinY = ay2: aMaxY = ay1
If bx1 < bx2 Then bMinX = bx1: bMaxX = bx2 Else bMinX = bx2: bMaxX = bx1
If by1 < by2 Then bMinY = by1: bMaxY = by2 Else bMinY = by2: bMaxY = by1
If intersect = 0 Then 'no intersect
twoSegmentsIntersect% = 0
ElseIf intersect = 1 Then 'segments intersect at one point
If ax1 = ax2 Then 'is iy between
If iy < aMinY Or iy > aMaxY Or ix < bMinX Or ix > bMaxX Then
twoSegmentsIntersect% = 0
Else
ix1 = ix: iy1 = iy: twoSegmentsIntersect% = 1
End If
ElseIf bx1 = bx2 Then
If iy < bMinY Or iy > bMaxY Or ix < aMinX Or ix > aMaxX Then
twoSegmentsIntersect% = 0
Else
ix1 = ix: iy1 = iy: twoSegmentsIntersect% = 1
End If
Else
If (aMinX <= ix And ix <= aMaxX) And (bMinX <= ix And ix <= bMaxX) Then
ix1 = ix: iy1 = iy: twoSegmentsIntersect% = 1
Else
twoSegmentsIntersect% = 0
End If
End If
ElseIf intersect = -1 Then 'segments are on same line get over lap section
'first check if both are on vertical line
If ax1 = ax2 Then 'and we know both are same line we have two vertical segemnts, do they over lap?
ix1 = ax1: ix2 = ax1
If aMinY < bMinY Then
If aMaxY < bMinY Then
twoSegmentsIntersect% = 0
Else
twoSegmentsIntersect% = -1: iy1 = bMinY
If aMaxY > bMaxY Then
iy2 = bMaxY
Else
iy2 = aMaxY
End If
End If
Else 'bMinY <= aMinY
If bMaxY < aMinY Then
twoSegmentsIntersect% = 0
Else
twoSegmentsIntersect% = -1: iy1 = aMinY
If bMaxY > aMaxY Then
iy2 = aMaxY
Else
iy2 = bMaxY
End If
End If
End If
Else 'the same line is not vertical
If aMinX < bMinX Then
If aMaxX < bMinX Then
twoSegmentsIntersect% = 0
Else
twoSegmentsIntersect% = -1: ix1 = bMinX
If bx1 = bMinX Then iy1 = by1 Else iy1 = by2
If aMaxX > bMaxX Then
ix2 = bMaxX
If bx1 = bMaxX Then iy2 = by1 Else iy2 = by2
Else
ix2 = aMaxX
If ax1 = aMaxX Then iy2 = ay1 Else iy2 = ay2
End If
End If
Else 'aMinX >= bMinX
If aMinX > bMaxX Then
twoSegmentsIntersect% = 0
Else
twoSegmentsIntersect% = -1: ix1 = aMinX
If ax1 = aMinX Then iy1 = ay1 Else iy1 = ay2
If bMaxX > aMaxX Then
ix2 = aMaxX
If ax1 = aMaxX Then iy2 = ay1 Else iy2 = ay2
Else
ix2 = bMaxX
If bx1 = bMaxX Then iy2 = by1 Else iy2 = by2
End If
End If
End If
End If
End If
End Function
' this function needs: SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept)
Function lineIntersectLine% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
If ax1 = ax2 Then 'line a is vertical
If bx1 = bx2 Then ' b is vertical
If ax1 = bx1 Then lineIntersectLine% = -1 ' if x's are same it is same vertical line
Exit Function '
Else
ix = ax1
slopeYintersect bx1, by1, bx2, by2, m2, y02
iy = m2 * ix + y02
lineIntersectLine% = 1 'signal a point was found
Exit Function
End If
Else
slopeYintersect ax1, ay1, ax2, ay2, m1, y01 ' -m = a, 1 = b, y0 = c std form
End If
If bx1 = bx2 Then 'b is vertical
ix = bx1: iy = m1 * ix + y01: lineIntersectLine% = 1 'signal a point was found
Exit Function
Else
slopeYintersect bx1, by1, bx2, by2, m2, y02 ' -m = a, 1 = b, y0 = c std form
End If
d = -m1 - -m2 ' if = 0 then parallel or equal because slopes are same
If Abs(d) > .05 Then 'otherwise about 0 <<< tighten down from .2 to .05
ix = (y01 - y02) / d: iy = (-m1 * y02 - -m2 * y01) / d
lineIntersectLine% = 1 'signal one intersect point was found
Else 'same line or parallel? if y0 (y-axis interssect) are same they are the same
If Abs(y01 - y02) < 15 Then lineIntersectLine% = -1 'signal same line! <<< loosen more! 5 to 15
End If
End Function
b = b + ...