Take the two derives equations (lines) y = ax + b y = cx + d If a <> c then derive x where lines meet in y. ax + b = cx + d ax - cx = d - b (a-c)x = d - b x = (d- b)/(a - c) Substitute in one equation for y: y = a * (d-b)/(a - c) + b
Tweet
#COMPILE EXE
#DIM ALL
TYPE LineEqu
x1 AS DOUBLE
y1 AS DOUBLE
x2 AS DOUBLE
y2 AS DOUBLE
a AS DOUBLE
b AS DOUBLE
END TYPE
FUNCTION PBMAIN() AS LONG
LOCAL l1, l2 AS LineEqu
LOCAL x,y AS DOUBLE
LOCAL flgVert1,flgVert2 AS LONG
LOCAL s AS STRING
l1.x1 =4
l1.y1 =5
l1.x2 =3
l1.y2 =1
l2.x1 =0
l2.y1 =0
l2.x2 =6
l2.y2 =1
flgVert1 = CalcLine(l1)
flgVert2 = CalcLine(l2)
IF flgVert1 AND FlgVert2 THEN
s = "Two vertical lines - no intersect"
ELSEIF l1.a = l2.a THEN
s = "lines are parallel - no intersect"
ELSEIF flgVert1 THEN 'first line vertical
y = l1.y1
x = (y-l2.b)/l2.a
s = "intersect at (" & STR$(x,5) & " ," & STR$(y,5) & ")"
ELSEIF flgVert2 THEN 'second line vertical
y = l2.y1
x = (y-l1.b)/l1.a
s = "intersect at (" & STR$(x,5) & " ," & STR$(y,5) & ")"
ELSE
x = (l2.b - l1.b)/(l1.a - l2.a)
y = l1.a * (l2.b-l1.b)/(l1.a - l2.a) + l1.b
s = "intersect at (" & STR$(x,5) & " ," & STR$(y,5) & ")"
END IF
? s
END FUNCTION
FUNCTION CalcLine(l AS LineEqu) AS LONG
'calculates a and b for equation in the form y=ax + b (except where line is vertical)
'from points x1,y1 and x2,y2
IF l.x1 = l.x2 THEN ' vertical line
l.a = 0
l.b = l.x1
FUNCTION = 1 ' Vertical - can't use y = ax+b, instead it's just X = b
ELSEIF l.y1 = l.y2 THEN ' horizontal line
l.a = 0
l.b = l.x1
ELSE
l.a = (l.y2-l.y1)/(l.x2-l.x1)
l.b = (l.x2*l.y1-l.x1*l.y2)/(l.x2-l.x1)
END IF
END FUNCTION
'
' Line 1 l1.x1= 0 l1.y1= 1 l1.x2= 1 l1.y2= 1 ' Line 2 l2.x1= 0.5 l2.y1= 0 l2.x2= 0.5 l2.y2= 1
' 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 )
IF erFlag = 0 THEN
? " The intersection point is X = " + STR$(xintp) + " , Y = " + STR$(yintp) + _
$CRLF + " for Data set # " + setNumSt
ELSE
? " No intersection point"
' exit function
END IF
' draw the graphics
DrwGraphics(x1, y1, x2,y2 , x3,y3 , x4, y4, xintp, yintp,setNumSt, erFlag)
END FUNCTION
' draw the graphics of the lines and intersection point
SUB DrwGraphics( 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)
' draw the graphics
' pirated from
' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/816259-how-to-draw-a-polygon-graphically?p=816366#post816366
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 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
' intersection point exist
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 1
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
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
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 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 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
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
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 = 1
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
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