Option Explicit

Type VectorType
	x As Double
	y As Double
	z As Double
End Type

Type PointType
	x As Double
	y As Double
	z As Double
End Type

Type LineType
	pstart As PointType
	pend As PointType
End Type

Private Sub dbgPoint( ByRef p As PointType )
	Debug.Print "X = " & p.X & ", Y = " & p.Y & " Z = " & p.Z
End Sub

Private Sub dbgLine( ByRef l As LineType )
	Debug.Print "Line Start"
	dbgPoint( l.pstart )
	Debug.Print "Line End"
	dbgPoint( l.pend )
End Sub

Private Function length( ByRef v As vectortype ) As Double
	length = Sqr( v.X * v.X + v.Y * v.Y + v.Z * v.Z )
End Function

Private Sub normalize( ByRef v As vectortype )
	Dim l As Double
	l = length( v )
	v.X = v.X / l
	v.Y = v.Y / l
	v.Z = v.Z / l
End Sub

Private Function dotProduct( ByRef v1 As vectortype, ByRef v2 As vectortype ) As Double
	dotProduct = v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z
End Function

Private Function apxEqual( ByVal a As Double, ByVal b As Double, ByVal epsilon As Double ) As Boolean
	If Abs( a - b ) < epsilon Then
		apxEqual = True
	Else
		apxEqual = False
	End If
End Function

Private Sub vectorFromTwoPoints( ByRef v As vectortype, _
	ByRef pstart As PointType, _
	ByRef pend As PointType )
	v.X = pend.X - pstart.X
	v.Y = pend.Y - pstart.Y
	v.Z = pend.Z - pstart.Z
End Sub

Private Sub vectorFromScalarTimesVector( ByRef r As vectortype, ByVal a As Double, ByRef v As VectorType )
	r.X = a * v.X
	r.Y = a * v.Y
	r.Z = a * v.Z
End Sub


' the lines must be in the same z plane
'
' return TRUE on success, FALSE on failure
' p will contain the intersection point if success
'
Private Function PointFromIntersectionOfTwoLines( ByRef p As PointType, ByRef l1 As LineType, ByRef l2 As LineType, ByRef t As Double ) As Boolean
	If l1.pstart.Z <> l1.pend.Z Or l1.pend.Z <> l2.pstart.Z Or l2.pstart.Z <> l2.pend.Z Then
		MsgBox "All points must lie in the same Z plane."
		PointFromIntersectionOfTwoLines = False
		Exit Function
	End If

	Dim v1 As vectortype
	Call vectorFromTwoPoints( v1, l1.Pstart, l1.pend )

	Dim v2 As vectortype
	Call vectorFromTwoPoints( v2, l2.Pstart, l2.Pend )

	normalize( v1 )
	normalize( v2 )

	Dim cosine As Double

	cosine = dotProduct( v1, v2 )

	Dim denom As Double

	denom = cosine * cosine - 1

	If apxEqual( denom, 0, 0.0001 ) Then
		MsgBox "The lines are parallel."
		PointFromIntersectionOfTwoLines = False
		Exit Function
	End If

	Dim v3 As vectortype
	Call vectorFromTwoPoints( v3, l1.Pstart, l2.Pstart )

	Dim v4 As vectortype
	Call vectorFromScalarTimesVector( v4, cosine, v2 )
	v4.X = v4.X - v1.X
	v4.Y = v4.Y - v1.Y
	v4.Z = v4.Z - v1.Z

	t = dotProduct( v3, v4 ) / denom

	p.X = l1.pstart.X + t * v1.X
	p.Y = l1.pstart.Y + t * v1.Y
	p.Z = l1.pstart.Z
	PointFromIntersectionOfTwoLines = True
End Function

' pick the line that you want to extend first.
' then pick the line that you want to extend it to.
' then call the macro.
'
' it will extend to the imaginary intersection point if necessary.
'
' infinte lines are not handled.
'
Public Sub LineExtendToAnotherLine
	Dim doc As FMDocument

	Set doc = Application.ActiveDocument

	Dim models As FMModels

	Set models = doc.Selected

	If models.Count <> 2 Then
		MsgBox "Please select two lines."
		Exit Sub
	End If

	If models(1).ModelType = eMT_Line And _
		models(2).ModelType = eMT_Line Then
		Dim l1m As FMLine
		Dim l2m As FMLine

		Set l1m = models(1)
		Set l2m = models(2)

		Dim l1 As LineType
		Dim l2 As LineType
		Dim x As Variant
		Dim y As Variant
		Dim z As Variant

		l1m.GetEndpoints(l1.pstart.X,l1.pstart.Y,l1.pstart.Z, x, y, z)
		l1.pend.X = x
		l1.pend.Y = y
		l1.pend.Z = z
		l2m.GetEndpoints(l2.pstart.X,l2.pstart.Y,l2.pstart.Z,x, y, z)
		l2.pend.X = x
		l2.pend.Y = y
		l2.pend.Z = z

		Dim p As PointType
		Dim t As Double

		If PointFromIntersectionOfTwoLines( p, l1, l2, t ) Then
			If t > 0 Then
				l1m.SetEndpoints( l1.pstart.X, l1.pstart.Y, l1.pstart.Z, p.X, p.Y, p.Z )
			Else
				l1m.SetEndpoints( p.X, p.Y, p.Z, l1.pend.X, l1.pend.Y, l1.pend.Z )
			End If
		Else
			MsgBox "Intersection failed."
		End If
	Else
		MsgBox "Please select two lines."
	End If
End Sub