Tweet
Here's my contribution with help from other members of this forum. This program takes in 4 points coordinates for the 2 lines
and compute the intersection point (if any) and plots these points graphically
6 sets of data are used - just uncomment each set and run the program.
and compute the intersection point (if any) and plots these points graphically
6 sets of data are used - just uncomment each set and run the program.
Code:
' Intersection Point.bas
' Find an intersection point of of 2 straight lines
' straight line1 would have points x1 , y1 and x2,y2 while
' straight line2 would have points x3 , y3 and x4,y4
' adapted from
' https://dirask.com/posts/JavaScript-calculate-intersection-point-of-two-lines-for-given-4-points-VjvnAj
#COMPILE EXE
#DIM ALL
FUNCTION PBMAIN() AS LONG
LOCAL x1,x2,x3 , x4 ,y1,y2,y3, y4 AS DOUBLE
LOCAL xintp , yintp AS DOUBLE
LOCAL setNumSt AS STRING
LOCAL erFlag AS LONG
' The following data sets 2, 2B, 3, 4 are from
' https://social.msdn.microsoft.com/Forums/en-US/4eb3423e-eb81-4977-8ce5-5a568d53fd9b/get-the-intersection-point-of-two-lines?forum=vbgeneral
' While data set 1 is from
' https://dirask.com/posts/JavaScript-calculate-intersection-point-of-two-lines-for-given-4-points-VjvnAj
' data set 5 is by Stuart (thanks to Stuart)
' Data Set 1 - intersection point at X = 184.536822 and Y = 121.7855488
' Line 1
' x1= 85
' y1= 45
' x2= 260
' y2= 180
' Line 2
' x3= 225
' y3= 75
' x4= 65
' y4= 260
' setNumSt = " 1"
' Data Set 2 -- intersection point at X= -2.5 , Y = -2.5
' Line 1
' x1= 0
' y1= 0
' x2= 4
' y2= 4
' Line 2
' x3= 1
' y3= 0
' x4= 8
' y4= 5
' setNumSt = " 2"
' Data Set 2B -- intersection point at X= 2 , Y = 2
' Line 1
' x1= 0
' y1= 0
' x2= 4
' y2= 4
' Line 2
' x3= 0
' y3= 4
' x4= 4
' y4= 0
' setNumSt = " 2B"
' Data Set 3 -- No intersection point as the 2 lines are parallel
' Line 1
' x1= 0
' y1= 0
' x2= 4
' y2= 4
' Line 2
' x3= 1.5
' y3= 1
' x4= 5
' y4= 4.5
' setNumSt = " 3"
' Data Set 4 -- intersection point at X = 0.5 , Y = 1
' these two lines are perpendicular
' Line 1
' x1= 0
' y1= 1
' x2= 1
' y2= 1
' Line 2
' x3= 0.5
' y3= 0
' x4= 0.5
' y4= 1
' setNumSt = " 4"
' Data set 5 - intersection point at X = 2.86956521 and Y = 0.478260869
' by Stuart
' Line 1
x1 =4
y1 =5
x2 =3
y2 =1
' Line 2
x3 =0
y3 =0
x4 =6
y4 =1
setNumSt = " 5"
xintp = 0
yintp = 0
' obtain the intersection point
ObtainIntersPoint(x1, y1, x2,y2, x3,y3 , x4, y4, xintp, yintp, erFlag )
' draw the graphics of the intersecting Lines
DrwGraphics_Inter(x1, y1, x2,y2 , x3,y3 , x4, y4, xintp, yintp,setNumSt, erFlag)
END FUNCTION
' draw the graphics of the lines and intersection point
' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/816259-how-to-draw-a-polygon-graphically?p=816366#post816366
SUB DrwGraphics_Inter( gx1 AS DOUBLE ,gy1 AS DOUBLE ,gx2 AS DOUBLE ,gy2 AS DOUBLE , _
gx3 AS DOUBLE ,gy3 AS DOUBLE ,gx4 AS DOUBLE ,gy4 AS DOUBLE , _
wXinter AS DOUBLE , wYinter AS DOUBLE , gsetNumSt AS STRING , gerFlag AS LONG)
LOCAL hGraph AS DWORD
LOCAL xmin,xmax ,ymin, ymax AS DOUBLE
LOCAL xmark, ymark AS DOUBLE
' marks per axis
LOCAL NumStep AS LONG
' canvas margins
LOCAL lm, tm, rm, bm AS DOUBLE
' scaled margins
LOCAL slm, stm, srm, sbm AS DOUBLE
' scaled xy coordinates for circular dots
LOCAL scx , scy , xrat , yrat AS DOUBLE
LOCAL TitleLab, XaxisLab, YaxisLab AS STRING
LOCAL hFont1, hFontR AS DWORD
' set up fonts
FONT NEW "Lucida Console", 10, 0, 0, 0, 0 TO hFont1
' rotated font (needs to be true type)
FONT NEW "Lucida Console", 10, 0, 0, 0, 900 TO hFontR
' obtain the min and max coord of the 3 points
' to do the scaling
IF gerFlag = 0 OR gerFlag = 3 THEN
' intersection point exist
xmin = MIN(gx1,gx2,gx3,gx4,wXinter)
ymin = MIN(gy1,gy2,gy3,gy4,wYinter)
xmax = MAX(gx1,gx2,gx3,gx4,wXinter)
ymax = MAX(gy1,gy2,gy3,gy4,wYinter)
ELSE
' NO intersection point
xmin = MIN(gx1,gx2,gx3,gx4)
ymin = MIN(gy1,gy2,gy3,gy4)
xmax = MAX(gx1,gx2,gx3,gx4)
ymax = MAX(gy1,gy2,gy3,gy4)
END IF
GRAPHIC WINDOW NEW "Lines and Intersection point",100,100,500,500 TO hGraph
GRAPHIC ATTACH hGraph, 0
'white background
GRAPHIC CLEAR %WHITE
' Left , Right, Top and Bottom Canvas Margins (in pixels)
' adjust these to the canvas window size
lm = 130 : rm = 60 : tm = 90 : bm = 140
' Calculate the scaled margins
slm = lm * (xmax-xmin)/(GRAPHIC(CANVAS.X) - lm - rm)
srm = rm * (xmax-xmin)/(GRAPHIC(CANVAS.X) - lm - rm)
stm = tm * (ymax-ymin)/(GRAPHIC(CANVAS.Y) - tm - bm)
sbm = bm * (ymax-ymin)/(GRAPHIC(CANVAS.Y) - tm - bm)
' adjustments if scaled margins are zero
IF slm = 0 THEN
slm = lm * (xmax -xmax*0.5)/(GRAPHIC(CANVAS.X) - lm - rm)
END IF
IF srm = 0 THEN
srm = rm * (xmax-xmax*0.5)/(GRAPHIC(CANVAS.X) - lm - rm)
END IF
IF stm = 0 THEN
stm = tm * (ymax-ymax*0.5)/(GRAPHIC(CANVAS.Y) - tm - bm)
END IF
IF sbm = 0 THEN
sbm = bm * (ymax-ymax*0.5)/(GRAPHIC(CANVAS.Y) - tm - bm)
END IF
' x , y ratios of canvas
xrat = (xmax-xmin)/GRAPHIC(CANVAS.X)
yrat = (ymax-ymin)/GRAPHIC(CANVAS.Y)
IF xrat = 0 THEN
xrat = (xmax-xmax*0.5)/GRAPHIC(CANVAS.X)
END IF
IF yrat = 0 THEN
yrat = (ymax-ymax*0.5)/GRAPHIC(CANVAS.Y)
END IF
' calculate the size of the circular dot for the points
' adjust the multiplier to suit size of dot
scx = 7 * xrat
scy = 7 * yrat
' Scale Windows so that points coordinates fit nicely
GRAPHIC SCALE (xmin-slm, ymax+stm) - (xmax+srm, ymin-sbm)
' Line is in Lime over a white background
GRAPHIC WIDTH 2
GRAPHIC COLOR %RGB_LIME, %WHITE
' Draw the line 1
GRAPHIC LINE (gx1,gy1) - (gx2,gy2)
' Draw the line 2
GRAPHIC LINE (gx3,gy3) - (gx4,gy4)
' draw the points in large dots
'on Line 1
GRAPHIC BOX (gx1-scx,gy1-scy) - _
(gx1+scx, gy1+scy),100,%RGB_BLUE,%RGB_BLUE
GRAPHIC BOX (gx2-scx,gy2-scy) - _
(gx2+scx, gy2+scy),100,%RGB_BLUE,%RGB_BLUE
' on Line 2
GRAPHIC BOX (gx3-scx, gy3-scy) - _
(gx3+scx, gy3+scy),100,%RGB_BLUE,%RGB_BLUE
GRAPHIC BOX (gx4-scx, gy4-scy) - _
(gx4+scx, gy4+scy),100,%RGB_BLUE,%RGB_BLUE
' draw the intersection point
IF gerFlag = 0 OR gerFlag = 3 THEN
' intersection point exist
GRAPHIC BOX (wXinter-scx, wYinter-scy) - _
(wXinter + scx, wYinter+scy),100,%RGB_MAGENTA,%RGB_MAGENTA
END IF
' draw the axes -------------------------------------------------------
' calculate axes mark spacing based on data range / values
NumStep = 10
IF xmax = xmin THEN
xmark = CalculateStepSize(xmax*0.5, xmax, NumStep)
ELSE
xmark = CalculateStepSize(xmin, xmax, NumStep)
END IF
IF ymax = ymin THEN
ymark = CalculateStepSize( ymax*0.5, ymax, NumStep)
ELSE
ymark = CalculateStepSize(ymin, ymax, NumStep)
END IF
' Draw the axes labels
GRAPHIC WIDTH 1
GRAPHIC COLOR %RGB_MEDIUMBLUE, %WHITE
TitleLab = "Plot for data set #" + gsetNumSt
GRAPHIC SET FONT hFont1
GRAPHIC SET POS (xmax-(xmax-xmin)/2 - _
GRAPHIC(TEXT.SIZE.X, TitleLab)/2, ymax + stm*0.4)
GRAPHIC PRINT TitleLab
' Display the x axis label
XaxisLab = "X-Axis"
GRAPHIC SET POS (xmax-(xmax-xmin)/2 - _
GRAPHIC(TEXT.SIZE.X, XaxisLab)/2, ymin - sbm*0.45)
GRAPHIC PRINT XaxisLab
' Draws the x axis line
GRAPHIC WIDTH 2
GRAPHIC COLOR %RGB_BLACK, %WHITE
GRAPHIC LINE (xmin, ymin) - (xmax, ymin)
GRAPHIC WIDTH 1
' draw marks on the x axis
LOCAL nchar AS LONG
LOCAL rr AS DOUBLE
LOCAL km AS LONG
km = 0
FOR rr = xmin TO xmax STEP xmark
INCR km
GRAPHIC LINE (rr, ymin) - (rr, ymin-GRAPHIC(CELL.SIZE.Y)*0.75)
' Display the mark values
nchar =LEN( TRIM$(STR$(rr),ANY CHR$(0) + CHR$(32)+ CHR$(10) + CHR$(13)+ CHR$(9)))
IF nchar = 1 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*0.55, - GRAPHIC(CELL.SIZE.Y)*0.5)
ELSEIF nchar = 2 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*0.9, - GRAPHIC(CELL.SIZE.Y)*0.5)
ELSEIF nchar = 3 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*1.5, - GRAPHIC(CELL.SIZE.Y)*0.5)
ELSE
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*1.8, - GRAPHIC(CELL.SIZE.Y)*0.5)
END IF
' print the scale values on x axis
' (alternate values only to prevent clutter)
IF km MOD 2 = 0 THEN
IF xmark < .1 THEN
GRAPHIC PRINT TRIM$(FORMAT$(rr, "0.00"))
ELSEIF xmark < 1 THEN
GRAPHIC PRINT TRIM$(FORMAT$(rr, "0.0"))
ELSE
GRAPHIC PRINT TRIM$(rr)
END IF
END IF
NEXT rr
' Display the y axis label
' Using rotated font at 90deg
YaxisLab = "Y-Axis"
GRAPHIC SET FONT hFontR
GRAPHIC SET POS (xmin-slm*.7, (ymax-(ymax-ymin)/2) _
- GRAPHIC(TEXT.SIZE.X, YaxisLab)/2)
GRAPHIC PRINT YaxisLab
' back to font1
GRAPHIC SET FONT hFont1
' Draw the y axis line
GRAPHIC WIDTH 2
GRAPHIC COLOR %RGB_BLACK, %WHITE
GRAPHIC LINE (xmin, ymin) - (xmin, ymax)
GRAPHIC WIDTH 1
' draw marks on the Y axis
LOCAL tmpSt AS STRING
km = 0
FOR rr = ymin TO ymax STEP ymark
INCR km
GRAPHIC LINE (xmin, rr) - (xmin-GRAPHIC(CELL.SIZE.X), rr)
' Display the mark values
IF rr < .1 THEN
tmpSt = TRIM$(FORMAT$(rr, "0.00"))
ELSEIF rr < 1 THEN
tmpSt = TRIM$(FORMAT$(rr, "0.0"))
ELSEIF rr = 0 THEN
tmpSt = TRIM$(STR$(rr))
ELSE
tmpSt = TRIM$(STR$(rr))
END IF
nchar =LEN(TRIM$(tmpSt,ANY CHR$(0) + CHR$(32)+ CHR$(10) + CHR$(13)+ CHR$(9)))
IF rr = 0 THEN
nchar = 1
END IF
IF nchar <= 2 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*3, GRAPHIC(CELL.SIZE.Y)/2)
ELSEIF nchar = 3 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*4.2, GRAPHIC(CELL.SIZE.Y)/2)
ELSEIF nchar >= 4 THEN
GRAPHIC SET POS STEP (-GRAPHIC(CELL.SIZE.X)*4.5, GRAPHIC(CELL.SIZE.Y)/2)
END IF
' print scale values -- alternate values only
' to prevent cluther
IF km MOD 2 = 0 THEN
IF ymark < .1 THEN
GRAPHIC PRINT TRIM$(FORMAT$(rr, "0.00"))
ELSEIF ymark < 1 THEN
GRAPHIC PRINT TRIM$(FORMAT$(rr, "0.0"))
ELSE
GRAPHIC PRINT TRIM$(rr)
END IF
END IF
NEXT rr
' display the message
IF gerFlag = 0 THEN
? " The intersection point is X = " + STR$(wXinter) + " , Y = " + STR$(wYinter) + _
$CRLF + $CRLF + " For Data set # " + gsetNumSt
ELSEIF gerFlag = 3 THEN
? " Intersection point exist but NOT located on both lines"
ELSEIF gerFlag = 2 THEN
? " No intersection point"
ELSEIF gerFlag = 1 THEN
? " No intersection point -- invalid coordinates"
END IF
GRAPHIC WAITKEY$
GRAPHIC WINDOW END hGraph
END SUB
' Get the intersection point for 2 intersecting straight lines
' having 4 coordinate points
' adapted from
' https://dirask.com/posts/JavaScript-calculate-intersection-point-of-two-lines-for-given-4-points-VjvnAj
SUB ObtainIntersPoint( gx1 AS DOUBLE ,gy1 AS DOUBLE ,gx2 AS DOUBLE ,gy2 AS DOUBLE , _
gx3 AS DOUBLE ,gy3 AS DOUBLE ,gx4 AS DOUBLE ,gy4 AS DOUBLE , _
wXinter AS DOUBLE ,wYinter AS DOUBLE , wErrFlag AS LONG )
LOCAL cx34 , cy34 , cx12 , cy12 , denom AS DOUBLE
LOCAL uc1 , uc4 AS DOUBLE
LOCAL smallNum AS DOUBLE
' Note that wErrFlag indicates the various forms
' of the intersection point
' 0 indicates no error and that intersection point exist
' 1 indicates error -- invalid given coordinates
' 2 indicates error -- NO intersection point
' 3 indicates error -- intersection point exist but located
' out of X,Y ranges of the given lines points
wErrFlag = 0
' check that all coordinates are valid
' for line 1
IF gx1 = 0 AND gy1 = 0 THEN
IF gx2 = 0 AND gy2 = 0 THEN
' all coord are Invalid
' ? " invalid coordinates in Line 1"
wErrFlag = 1
EXIT SUB
END IF
END IF
' for line 2
IF gx3 = 0 AND gy3 = 0 THEN
IF gx4 = 0 AND gy4 = 0 THEN
' all coord are Invalid
' ? " invalid coordinates in Line 2"
wErrFlag = 1
EXIT SUB
END IF
END IF
' for Line 1
IF gx1 = gx2 AND gy1 = gy2 THEN
' all coord are Invalid
' ? " invalid coordinates in Line 1"
wErrFlag = 1
EXIT SUB
END IF
' for Line 2
IF gx3 = gx4 AND gy3 = gy4 THEN
' all coord are Invalid
' ? " invalid coordinates in Line 2"
wErrFlag = 1
EXIT SUB
END IF
'compute the denominator coefficients
cx12 = gx1 - gx2
cy12 = gy1 - gy2
cx34 = gx3 - gx4
cy34 = gy3 - gy4
denom = cx12 * cy34 - cy12 * cx34
smallNum = 0.0001
IF ABS(denom) <= smallNum THEN
' ? " No intersection "
wErrFlag = 2
EXIT SUB
END IF
' compute the numerator coefficients
uc1 = gx1 * gy2 - gy1 * gx2
uc4 = gx3 * gy4 - gy3 * gx4
' compute the intersection point
wXinter = (uc1 * cx34 - cx12 * uc4) / denom
wYinter = (uc1 * cy34 - cy12 * uc4) / denom
' Check whether the intersection point is located on both lines
' Line 1
LOCAL wFlag1X, wFlag1Y, wFlag1 AS LONG
wFlag1X = 0
wFlag1Y = 0
wFlag1 = 0
IF gx1 < gx2 THEN
IF wXinter <= gx2 AND wXinter >= gx1 THEN
' Intersection point lies within the bounds of
' line 1 x coordinates
wFlag1X = 1
END IF
ELSE
IF wXinter <= gx1 AND wXinter >= gx2 THEN
' Intersection point lies within the bounds of
' line 1 x coordinates
wFlag1X = 1
END IF
END IF
IF gy1 < gy2 THEN
IF wYinter <= gy2 AND wYinter >= gy1 THEN
' Intersection point lies within the bounds of
' line 1 Y coordinates
wFlag1Y = 1
END IF
ELSE
IF wYinter <= gy1 AND wYinter >= gy2 THEN
' Intersection point lies within the bounds of
' line 1 Y coordinates
wFlag1Y = 1
END IF
END IF
IF wFlag1X + wFlag1Y = 2 THEN
' intersection point is located on Line 1
wFlag1 = 1
END IF
' Line 2
LOCAL wFlag2X, wFlag2Y, wFlag2 AS LONG
wFlag2X = 0
wFlag2Y = 0
wFlag2 = 0
IF gx3 < gx4 THEN
IF wXinter <= gx4 AND wXinter >= gx3 THEN
' Intersection point lies within the bounds of
' line 2 x coordinates
wFlag2X = 1
END IF
ELSE
IF wXinter <= gx3 AND wXinter >= gx4 THEN
' Intersection point lies within the bounds of
' line 2 x coordinates
wFlag2X = 1
END IF
END IF
IF gy3 < gy4 THEN
IF wYinter <= gy4 AND wYinter >= gy3 THEN
' Intersection point lies within the bounds of
' line 2 Y coordinates
wFlag2Y = 1
END IF
ELSE
IF wYinter <= gy3 AND wYinter >= gy4 THEN
' Intersection point lies within the bounds of
' line 2 Y coordinates
wFlag2Y = 1
END IF
END IF
IF wFlag2X + wFlag2Y = 2 THEN
' intersection point is located on Line 2
wFlag2 = 1
END IF
' Finally for line 1 and Line 2
IF wFlag1 + wFlag2 = 2 THEN
' intersection point exist and it
' is located on BOTH lines
wErrFlag = 0
ELSE
' intersection point exist but it is
' NOT located on both lines
wErrFlag = 3
END IF
END SUB
' Thanks to Dave Biggs
' Compute the marks positions on the axes
' Approximately there are around 10 marks on each axes
FUNCTION CalculateStepSize(dmin AS DOUBLE, dmax AS DOUBLE, NStep AS LONG) AS DOUBLE
LOCAL dRange, tempstep, StepSize AS DOUBLE
LOCAL mag, magPow, magMsd, mult AS LONG
' NStep = 10 ' eg maximum marks on axis
dRange = dmax -dmin
IF dRange = 0 THEN
EXIT FUNCTION
END IF
' calculate an initial guess at step size
tempStep = dRange/NStep
' scale up low magnitude step sizes (avoid negative log10 values)
WHILE tempstep < 1
TempStep = TempStep * 10
INCR mult
WEND
' get the magnitude of the step size
mag = FIX(LOG10(tempStep))
magPow = 10^mag
' calculate most significant digit of the new step size
magMsd = ((tempStep/magPow) + 0.5)
' promote the MSD TO either 1, 2, OR 5
IF (magMsd > 5.0) THEN
magMsd = 10.0
ELSEIF (magMsd > 2.0) THEN
magMsd = 5.0
ELSEIF (magMsd > 1.0) THEN
magMsd = 2.0
END IF
StepSize = magMsd*magPow
' reduce scaled up magnitudes if required
StepSize = StepSize / 10^mult
' Adjust _min and _max
dmin = StepSize * INT(dmin/StepSize)
dmax = StepSize * CEIL(dmax/StepSize)
FUNCTION = StepSize
END FUNCTION
Comment