Line intersection - with a difference

[theta]

I have been working on a problem and through all of my research I have been unable to find an existing resolution. I do not have the required math knowledge to produce an elegant solution.

There are several examples of working (and very elegant) line - line intersections with either complete lines or line segment (see links) :

https://dl.dropboxusercontent.com/u/99937114/Forums/Eileens Lounge - LinearIntersect_Corrected.xls

https://dl.dropboxusercontent.com/u/99937114/Forums/Eileens Lounge - ymxc Intersect.xls

https://dl.dropboxusercontent.com/u/99937114/Forums/Listen Data - Intersection.xls

https://dl.dropboxusercontent.com/u/99937114/Forums/AJP - ComplexIntersection.xls

The problem I have is illustrated using the attached image. There is a defined line, starting at L1 (x,y) and finishing at L2 (x,y). There is no second line - instead there are the coordinates for another point (effectively L3) and an axis or angle of travel. I need to calculate the distance to and coordinates of the intersect if the point L3 was continued along the axis / angle of travel.

 

[theta]

It would also be useful to get the coordinates of a position when provided with an origin, a bearing and a distance e.g. x, y with a distance of 10m on a bearing of 195 degrees arrives you at x, y?

 

[shg]

Each line can be expressed parametrically as an origin and some variable distance along a direction vector:

Line1 = point1 + s * (point2 - point1)

Line2 = point3 + t * {sin(angle), cos(angle)}

Some value of s and t is where the lines intersect.

Row\Col	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​
1​	​	x​	y​	angle​	​	​	​	​	​	​	​
2​	Point1	3​	3​
3​	Point2	13​	4​
4​	Dir	10.000​	1.000​						B4:C4: {=B3:C3 - B2:C2}
5​
6​
7​	Point3	23​	16​	195​
8​	Dir	-0.259​	-0.966​						B8: =SIN(RADIANS(D7))	C8: =COS(RADIANS(D7))
9​
10​
11​		10.000​	0.259​	*​	s​	=​	20​		B11: =B4	C11: =-B8	G11: =B7-B2
12​		1.000​	0.966​	​	t​	​	13​		B12: =C4	C12: =-C8	G12: =C7-C2
13​
14​	s​	1.70​							B14:B15: {=MMULT(MINVERSE(B11:C12), G11:G12)}
15​	t​	11.70​
16​
17​	Check 1	19.971​	4.697​						B17:C17: {=B2:C2 + B14 * B4:C4}
18​	Check 2	19.971​	4.697​						B18:C18: {=B7:C7 + B15 * B8:C8}

 

[shg]

Or more compactly,

Row\Col	A​	B​	C​	D​	E​	F​	G​
1​	​	x​	y​	angle​	​	​	​
2​	Point1	3​	3​
3​	Point2	13​	4​
4​	Dir	10.000​	1.000​			B4:C4: {=B3:C3 - B2:C2}
5​
6​	Point3	23​	16​	195​
7​	Dir	-0.259​	-0.966​			B7: =SIN(RADIANS(D6))	C7: =COS(RADIANS(D6))
8​
9​	s​	1.70​				B9:B10: {=MMULT(MINVERSE(CHOOSE({1,2;3,4}, B4, -B7, C4, -C7)), CHOOSE({1;2}, B6-B2, C6-C2))}
10​	t​	11.70​
11​
12​	Check1	19.971​	4.697​			B12:C12: {=B2:C2 + B9 * B4:C4}
13​	Check2	19.971​	4.697​			B13:C13: {=B6:C6 + B10 * B7:C7}

 

[theta]

Wow this is fantastic. Is there a VBA function version of this, so that I can call it on command - I have some large data sets where I have the information in the format provided.

If not I may be able to produce a template method, but the VBA would give me more freedom

I have been looking at a website called moveable typeface which covers alot of this, but it is all web orientated unfortunately

 

[shg]

Row\Col	A​	B​	C​	D​	E​
1​		x​	y​	angle​
2​	Point1	3​	3​
3​	Point2	13​	4​
4​
5​	Point3	23​	16​	195​
6​
7​	Isect	19.971​	4.697​		B7:C7: {=Isect(B2, C2, B3, C3, FALSE, B5, C5, SIN(RADIANS(D5)), COS(RADIANS(D5)), TRUE)}

Function Isect(x1 As Double, y1 As Double, ByVal x2 As Double, ByVal y2 As Double, Pt2AsDir As Boolean, _
               x3 As Double, y3 As Double, ByVal x4 As Double, ByVal y4 As Double, Pt4AsDir As Boolean) As Variant

  ' shg 2014

  ' Returns the point of intersection of two lines
  ' Pt2AsDir = True  =>  means {x2, y2} is a direction vector
  ' Pt2AsDir = False =>  means {x2, y2} is a second point on the line

  Dim s             As Double
  Dim v             As Variant

  If Pt2AsDir Then
    x2 = x2 + x1
    y2 = y2 + y1
  End If

  If Pt4AsDir Then
    x4 = x4 + x3
    y4 = y4 + y3
  End If

  v = IsectPrams(x1, y1, x2, y2, x3, y3, x4, y4)
  If VarType(v) = vbBoolean Then
    Isect = CVErr(xlErrValue)
  Else
    s = v(0)
    Isect = VBA.Array(x1 + s * (x2 - x1), y1 + s * (y2 - y1))
  End If
End Function

Function IsectPrams(x1 As Double, y1 As Double, _
                    x2 As Double, y2 As Double, _
                    x3 As Double, y3 As Double, _
                    x4 As Double, y4 As Double) As Variant

' shg 2013

  Dim d             As Double   ' denominator of s and t

  d = (x4 - x3) * (y2 - y1) - (x2 - x1) * (y4 - y3)

  If d = 0 Then
    IsectPrams = False
  Else
    IsectPrams = VBA.Array(((x4 - x3) * (y3 - y1) - (x3 - x1) * (y4 - y3)) / d, _
                           ((x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1)) / d)
  End If
End Function

 

[theta]

Row\Col	A​	B​	C​	D​	E​
1​		x​	y​	angle​
2​	Point1	3​	3​
3​	Point2	13​	4​
4​
5​	Point3	23​	16​	195​
6​
7​	Isect	19.971​	4.697​		B7:C7: {=Isect(B2, C2, B3, C3, FALSE, B5, C5, SIN(RADIANS(D5)), COS(RADIANS(D5)), TRUE)}

<tbody>
</tbody>

Function Isect(x1 As Double, y1 As Double, ByVal x2 As Double, ByVal y2 As Double, Pt2AsDir As Boolean, _
               x3 As Double, y3 As Double, ByVal x4 As Double, ByVal y4 As Double, Pt4AsDir As Boolean) As Variant

  ' shg 2014

  ' Returns the point of intersection of two lines
  ' Pt2AsDir = True  =>  means {x2, y2} is a direction vector
  ' Pt2AsDir = False =>  means {x2, y2} is a second point on the line

  Dim s             As Double
  Dim v             As Variant

  If Pt2AsDir Then
    x2 = x2 + x1
    y2 = y2 + y1
  End If

  If Pt4AsDir Then
    x4 = x4 + x3
    y4 = y4 + y3
  End If

  v = IsectPrams(x1, y1, x2, y2, x3, y3, x4, y4)
  If VarType(v) = vbBoolean Then
    Isect = CVErr(xlErrValue)
  Else
    s = v(0)
    Isect = VBA.Array(x1 + s * (x2 - x1), y1 + s * (y2 - y1))
  End If
End Function

Function IsectPrams(x1 As Double, y1 As Double, _
                    x2 As Double, y2 As Double, _
                    x3 As Double, y3 As Double, _
                    x4 As Double, y4 As Double) As Variant

' shg 2013

  Dim d             As Double   ' denominator of s and t

  d = (x4 - x3) * (y2 - y1) - (x2 - x1) * (y4 - y3)

  If d = 0 Then
    IsectPrams = False
  Else
    IsectPrams = VBA.Array(((x4 - x3) * (y3 - y1) - (x3 - x1) * (y4 - y3)) / d, _
                           ((x2 - x1) * (y3 - y1) - (x3 - x1) * (y2 - y1)) / d)
  End If
End Function

Amazing! I will look through this tonight and have a play - producing a mockup of what the solution should hopefully do

Once this is solved, I can hopefully finish the addin!

 

[shg]

You're welcome, good luck.

 

[theta]

You're welcome, good luck.

It works perfectly. I will upload a working example of the workbook (rough) with some direction.

I like how the line is created using a single point and an angle

I would like to create two infinite lines / calculate the intersect using either [two coordinates] or [a single point and a slope / bearing] in different combinations as input parameters - how would one change the VBA? (basically adjusting what you have already created) e.g.

[line 1 = x and y coordinates] and [line 2 = single point and bearing]

or

[line 1 = single point and bearing] and [line 2 = single point and bearing]

or

[line 1 = x and y coordinates] and [line 2 = x and y coordinates]

This would give me fantastic flexibility. And then I could expand to calculate the distance between the single point and the intersect