It might be useful for something

[bplus]

Good stuff! let me know if you want exact point (coordinates) of intersect, though my code is a little longer

I 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