×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Are you an
Engineering professional?
Join Eng-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# Equation solver , find intersection from infinite line to shape vba/java

## Equation solver , find intersection from infinite line to shape vba/java

(OP)
I'm trying to implement this situation inside an actual VBA/java program.

https://www.geogebra.org/calculator/qranh66u

I need to acquire the intersections point created by the shape and the intersection line. I surfed the web and studied newton's method and other approaches, but they seem all too complex or hardly implementable.

Is there a way to find the intersection point given the equation you see in the link?

From eq1 to f, I have to find A and B

for example:

eq1: (((abs(x))/(a)))^(2 ((a)/(r)))+(((abs(y))/(b)))^(2 ((b)/(r)))=1

intersection with

f: y=tan(15 ((π)/(180))) x

when a = 900
and b = 400
and r=5
it
generates
POINT A (-4,-1.07) and point B ( 4+1.07)

I need to implement this function in a program, so when I change "f" or "eq1" parameters I get the new points

Java or VBA but VBA is preferable

So if you can give me some info, or at least where to watch it would be great. Thanks!

### RE: Equation solver , find intersection from infinite line to shape vba/java

Here's something I prepared earlier.... VBA to return all intersections for two lines with X/Y coordinates

Links in code to certain articles/algorithms on which it is based

Code could definitely be simplified, I tend to refactor a lot of stuff so I can use it in multiple functions without repeating.

Try this:-

#### CODE --> VBA

Public Function geo_line_complex_intersect(xy_line_1 As Variant, xy_line_2 As Variant, Optional compact_results As Boolean = True) As Variant
'function to return all XY intersections between two defined continuous lines or broken lines
'leave blank rows or #NA between line coordinates to use individual unconnected lines as inputs

'create array from input data
xy_line_1 = array_convert_rng_to_array(xy_line_1)
xy_line_2 = array_convert_rng_to_array(xy_line_2)

On Error GoTo 0
Dim line_1_count As Long
Dim line_2_count As Long
Dim i As Long
Dim count_x As Long
Dim count_y As Long
Dim x1_line_1 As Double
Dim x2_line_1 As Double
Dim x1_line_2 As Double
Dim x2_line_2 As Double
Dim y1_line_1 As Double
Dim y2_line_1 As Double
Dim y1_line_2 As Double
Dim y2_line_2 As Double
Dim xy_intersection(1 To 1, 1 To 2) As Variant
Dim xy_intersection_results As Variant
Dim x_intersection As Double
Dim y_intersection As Double
Dim line_1_segment(1 To 2, 1 To 2)
Dim line_2_segment(1 To 2, 1 To 2)
Dim temp

'replace any #NA errors with equivalent of 'Empty'/vbNullString
xy_line_1 = array_replace_errors(xy_line_1)
xy_line_2 = array_replace_errors(xy_line_2)

'loop through first line line segments and check for intersections with all segments of second line
For line_1_count = 1 To UBound(xy_line_1) - 1
'create line 1 segment array
line_1_segment(1, 1) = xy_line_1(line_1_count, 1)
line_1_segment(2, 1) = xy_line_1(line_1_count + 1, 1)
line_1_segment(1, 2) = xy_line_1(line_1_count, 2)
line_1_segment(2, 2) = xy_line_1(line_1_count + 1, 2)

'check if line 1 segment includes blank/empty coordinate rows, and skip processing this line segment
If array_value_in_array(vbNullString, line_1_segment) Then GoTo skip_line_1

For line_2_count = 1 To UBound(xy_line_2) - 1
'create line 2 segment array
line_2_segment(1, 1) = xy_line_2(line_2_count, 1)
line_2_segment(2, 1) = xy_line_2(line_2_count + 1, 1)
line_2_segment(1, 2) = xy_line_2(line_2_count, 2)
line_2_segment(2, 2) = xy_line_2(line_2_count + 1, 2)

'check if line 2 segment includes blank/empty coordinate rows, and skip processing this line segment
If array_value_in_array(vbNullString, line_2_segment) Then GoTo skip_line_2

'check and determine intersection point coordinates
temp = geo_line_intersect(line_1_segment, line_2_segment)

'create intersection coordinates results array
If i = 0 Then
'first intersection
xy_intersection(1, 1) = temp(0)
xy_intersection(1, 2) = temp(1)
xy_intersection_results = xy_intersection
i = 1
Else
'subsequent intersections
xy_intersection(1, 1) = temp(0)
xy_intersection(1, 2) = temp(1)
xy_intersection_results = CombineArrays(xy_intersection_results, xy_intersection)
End If
skip_line_2:
Next line_2_count
skip_line_1:
Next line_1_count

'compact results removing any #NA rows/results
If compact_results Then
xy_intersection_results = array_remove_error_rows(xy_intersection_results)
End If

'return results
geo_line_complex_intersect = xy_intersection_results

End Function

Public Function geo_line_intersect(xy_line_1 As Variant, xy_line_2 As Variant) As Variant
'test to determine if two lines intersect based on XY coordinates, returns XY coordinate of intersection point if
'line segments cross each other. Otherwise returns NA errors
'Refer https://en.wikipedia.org/wiki/Line-line_intersection

'create array from input data
xy_line_1 = array_convert_rng_to_array(xy_line_1)
xy_line_2 = array_convert_rng_to_array(xy_line_2)

'setup variables for individual points
Dim x1_line_1 As Double
Dim x2_line_1 As Double
Dim x1_line_2 As Double
Dim x2_line_2 As Double
Dim y1_line_1 As Double
Dim y2_line_1 As Double
Dim y1_line_2 As Double
Dim y2_line_2 As Double
Dim x_intersection As Double
Dim y_intersection As Double

Dim t As Double
Dim u As Double
Dim denominator As Double

x1_line_1 = xy_line_1(1, 1)
x2_line_1 = xy_line_1(2, 1)
x1_line_2 = xy_line_2(1, 1)
x2_line_2 = xy_line_2(2, 1)
y1_line_1 = xy_line_1(1, 2)
y2_line_1 = xy_line_1(2, 2)
y1_line_2 = xy_line_2(1, 2)
y2_line_2 = xy_line_2(2, 2)

'denominator, if denominator is zero then lines are parallel
denominator = (x1_line_1 - x2_line_1) * (y1_line_2 - y2_line_2) - (y1_line_1 - y2_line_1) * (x1_line_2 - x2_line_2)

If denominator <> 0 Then
'lines are not parallel
t = ((x1_line_1 - x1_line_2) * (y1_line_2 - y2_line_2) - (y1_line_1 - y1_line_2) * (x1_line_2 - x2_line_2)) / denominator
u = -((x1_line_1 - x2_line_1) * (y1_line_1 - y1_line_2) - (y1_line_1 - y2_line_1) * (x1_line_1 - x1_line_2)) / denominator
Else
'line segments are parallel
geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
Exit Function
End If

'check if lines intersect
If u >= 0 And u <= 1 And t >= 0 And t <= 1 Then
'line segments do intersect
'intersection point coordinates
x_intersection = x1_line_1 + t * (x2_line_1 - x1_line_1)
y_intersection = y1_line_1 + t * (y2_line_1 - y1_line_1)
geo_line_intersect = Array(x_intersection, y_intersection)
Else
'line segments do not intersect
geo_line_intersect = Array(CVErr(xlErrNA), CVErr(xlErrNA))
End If

End Function

Public Function array_remove_error_rows(arr As Variant) As Variant
'Function to remove rows that contain an error in array

arr = array_convert_rng_to_array(arr)

Dim temp_arr As Variant
Dim valid_count As Long
Dim row_count As Long
Dim row1 As Long
Dim row2 As Long
Dim col_count As Long
Dim col_loop As Long
Dim col1 As Long
Dim col2 As Long

'establish array limits for 1st and 2nd dimensions
row1 = LBound(arr, 1)
row2 = UBound(arr, 1)
col1 = LBound(arr, 2)
col2 = UBound(arr, 2)

'determine number of valid points and write to array removing #NA results
valid_count = LBound(arr, 1) - 1

For row_count = row1 To row2
For col_count = col1 To col2
If IsError(arr(row_count, col_count)) Then
GoTo skip_row
End If
'at end of row (at last column) execute following if there were no errors in the row of data and
're-write entire row values to new row position
If col_count = col2 Then    'last column
valid_count = valid_count + 1
'loop through all columns at current row and populate values to new position
For col_loop = col1 To col2
arr(valid_count, col_loop) = arr(row_count, col_loop)
Next col_loop
End If
Next col_count
skip_row:
Next row_count

'resize results array to remove trailing #NA results
temp_arr = arr
ReDim arr(row1 To valid_count, col1 To col2)
For row_count = row1 To valid_count
For col_count = col1 To col2
arr(row_count, col_count) = temp_arr(row_count, col_count)
Next col_count
Next row_count

'return results
array_remove_error_rows = arr

End Function

Public Function array_value_in_array(value_to_be_found As Variant, arr As Variant) As Boolean
'Function to check if a value is in an array of values

Dim element As Variant
On Error GoTo error_handling:
For Each element In arr
If element = value_to_be_found Then
array_value_in_array = True
Exit Function
End If
Next element
Exit Function
error_handling:
On Error GoTo 0
array_value_in_array = False

End Function

Function array_convert_rng_to_array(arr As Variant)
'function to convert ranges to arrays

Dim temp As Variant
'if already an array exit function returning same array
If IsArray(arr) Then
array_convert_rng_to_array = arr
Exit Function
End If

'convert range input into array
If arr.Columns.Count = 1 And arr.Rows.Count = 1 Then
temp = arr.Value2
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = temp
array_convert_rng_to_array = arr
Else
array_convert_rng_to_array = arr.Value2
End If

End Function

Public Function array_replace_errors(arr As Variant) As Variant
'Function to replace all array values that are errors with 'Empty'/check if a value is in an array of values

arr = array_convert_rng_to_array(arr)

Dim row_count As Long
Dim col_count As Long

'loop through all elements in array and replace any errors with 'Empty'/vbNullString
For row_count = LBound(arr, 1) To UBound(arr, 1)
For col_count = LBound(arr, 2) To UBound(arr, 2)
If IsError(arr(row_count, col_count)) Then arr(row_count, col_count) = vbNullString
Next col_count
Next row_count

'return results
array_replace_errors = arr

End Function

Function CombineArrays(a As Variant, b As Variant, Optional stacked As Boolean = True) As Variant
'assumes that A and B are 2-dimensional variant arrays
'if stacked is true then A is placed on top of B
'in this case the number of rows must be the same,
'otherwise they are placed side by side A|B
'in which case the number of columns are the same
'LBound can be anything but is assumed to be
'the same for A and B (in both dimensions)
'False is returned if a clash

Dim lb As Long, m_A As Long, n_A As Long
Dim m_B As Long, n_B As Long
Dim m As Long, n As Long
Dim i As Long, j As Long, k As Long
Dim c As Variant

If TypeName(a) = "Range" Then a = a.Value
If TypeName(b) = "Range" Then b = b.Value

lb = LBound(a, 1)
m_A = UBound(a, 1)
n_A = UBound(a, 2)
m_B = UBound(b, 1)
n_B = UBound(b, 2)

If stacked Then
m = m_A + m_B + 1 - lb
n = n_A
If n_B <> n Then
CombineArrays = False
Exit Function
End If
Else
m = m_A
If m_B <> m Then
CombineArrays = False
Exit Function
End If
n = n_A + n_B + 1 - lb
End If
ReDim c(lb To m, lb To n)
For i = lb To m
For j = lb To n
If stacked Then
If i <= m_A Then
c(i, j) = a(i, j)
Else
c(i, j) = b(lb + i - m_A - 1, j)
End If
Else
If j <= n_A Then
c(i, j) = a(i, j)
Else
c(i, j) = b(i, lb + j - n_A - 1)
End If
End If
Next j
Next i
CombineArrays = c
End Function 

### RE: Equation solver , find intersection from infinite line to shape vba/java

https://newtonexcelbach.com/2018/12/27/more-update...

To use either of these for the problem in the original post the coordinates need to be defined for all of the lines to be intersected, and the formula generating the "rectangular" shape involves very high powers that are likely to cause numerical problems with most equation solvers.

Because in this case the rectangle is vertical, if the x value of the vertical legs can be found it is a simple matter of substituting that into the equation for the sloping line.

By trial and error (and looking at the results in the link) I found that for the given a, b and r values the vertical legs of the rectangle are at x = +-900 and the intersection points are therefore at y = +-241.1542732

Excel goalseek also (eventually) came up with a result close to x=900 for the vertical lines.

I'm wondering if the example is a practical problem, or just one taken from the link? For most problems involving intersections of curvilinear equations there are automated numerical solutions that will work better than they do for this case.

Doug Jenkins
Interactive Design Services
http://newtonexcelbach.wordpress.com/

### RE: Equation solver , find intersection from infinite line to shape vba/java

#### Quote (IDS)

Because in this case the rectangle is vertical, if the x value of the vertical legs can be found it is a simple matter of substituting that into the equation for the sloping line.

Unless the sloping line misses one or both vertical parts of the rectangle and that is important?
Then you'll get a result by substituting the X value, but it will be incorrect assuming Olivia86 is after the exact intersections. Like you I don't know if this is simply a pure geometry problem, or a way of solving another separate problem by utilising the geometry. Your suggestion may be appropriate within the bound of the problem the OP is trying to solve, but you need to be aware of the potential to report an incorrect result if intersections with the horizontal part of the rectangle are important tot the solution?

### RE: Equation solver , find intersection from infinite line to shape vba/java

#### Quote (Agent666)

Unless the sloping line misses one or both vertical parts of the rectangle and that is important?

Sure, but if you have the coordinates of the four corners it's easy to check for that, and if you don't you can't use our intersection spreadsheets either.

Doug Jenkins
Interactive Design Services
http://newtonexcelbach.wordpress.com/

### RE: Equation solver , find intersection from infinite line to shape vba/java

(OP)
Hi everyone, there is a lot of material here. Thanks for your effort.

Actually, I'm just using X= 900 and X=900, finding the intersection of y=mx and x=y/m, then I'm setting the boundary to exit the various loop. But I'm still in developing, it's just conceptual.

#### Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

#### Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Close Box

# Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!