PDA

View Full Version : Calculate distance between point and rectangle



vincentzack
07-11-2016, 05:34 AM
I have some rectangles with width, height and the coordinates of the center. I need to calculate the shortest distance between point and rectangle. The rectangle can be rotated a angle with X-axis. In other word, the rectangle is not aligned X-axis or Y-axis.
16594

Is there a easy formula or function to calculate this? Are there some resources on this problem?

Thank you very much!

snb
07-11-2016, 05:50 AM
see http://www.vbaexpress.com/forum/showthread.php?56539-Check-Points-within-Rectangles

Kenneth Hobs
07-11-2016, 07:26 AM
As explained in a duplicate post of yours, http://stackoverflow.com/questions/38308152/calculate-distance-between-point-and-rectangle, one needs to know the angle of rotation.

SNB sort of inferred that one may also need to know if the point is inside the shape or not.

vincentzack
07-11-2016, 07:42 AM
Angle of rotation is known. The point may fall inside the rectangle.

Kenneth Hobs
07-11-2016, 09:04 AM
1. Determine the coordinates for each of the line segment ends.
2. Compute distance from point to each of the lines represented by the edge lines or line segments.
3. Return the minimum distance.

If you post an example problem with a known answer, or attach a workbook, we can go from there.

For (2), this should help.

Sub Test_Dist2Line() 'P1 & P2 = points on line. P0= point to check distance from line.
'P0=(x0, y0), (P1(x1, y1), P2(x2, y2). P0(0,0) P1(0,1), P2(1,0).
Debug.Print Dist2Line(0, 0, Array(1, 0), Array(0, 1))
Debug.Print 1 / 2 ^ 0.5
Debug.Print Sin(WorksheetFunction.Radians(45))
End Sub


'http://answers.microsoft.com/en-us/office/forum/office_2010-excel/calculate-the-perpendicular-distance-of-a-point-to/a1f7bbdd-31b9-41b3-afad-fd996a4e8218?auth=1
'https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line
'Adjusted input order, Kennneth Hobson, July 11, 2016
Function Dist2Line(X As Double, Y As Double, Xs As Variant, Ys As Variant) As Double
'Distance from the point (X,Y) to a straight line with equation Y=A0+A1*X
'A0 and A1 are readily calculated by a linear regression from a series of mark points of the line
Dim A0 As Double, A1 As Double
A0 = WorksheetFunction.Intercept(Ys, Xs)
A1 = WorksheetFunction.Slope(Ys, Xs)
Dist2Line = Abs(A1 * X - Y + A0) / Sqr(A1 * A1 + 1)
End Function




Sub Test_Dist2LineSegment()
'P1 & P2 = points on line. P0= point to check distance from line.
'P0=(x0, y0), (P1(x1, y1), P2(x2, y2). P0(0,0) P1(0,1), P2(1,0).
Debug.Print Dist2LineSegment(0, 0, Array(1, 0), Array(0, 1))
Debug.Print 1 / 2 ^ 0.5
Debug.Print Sin(WorksheetFunction.Radians(45))
End Sub


Function Dist2LineSegment(x0 As Double, y0 As Double, Xs As Variant, Ys As Variant) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
x1 = Xs(0)
x2 = Xs(1)
y1 = Ys(0)
y2 = Ys(1)
Dist2LineSegment = (Abs((y2 - y1) * x0 - (x2 - x1) * y0 + x2 * y1 - y2 * x1)) / ((y2 - y1) ^ 2 + (x2 - x1) ^ 2) ^ 0.5
End Function

Sub Test_Dist2LineSegment2()
'P1 & P2 = points on line. P0= point to check distance from line.
'Answer is 0, since origin, P0(0,0) is on line P1(1,1) to P2(-1,-1)
Debug.Print Dist2LineSegment(0, 0, Array(1, -1), Array(1, -1))
End Sub


Sub Test_Dist2LineSegment3()
'P1 & P2 = points on line. P0= point to check distance from line.
'Answer is 1.
Debug.Print Dist2LineSegment(0, 0, Array(1, 1), Array(1, -1))
End Sub

Kenneth Hobs
07-11-2016, 01:33 PM
For (1), I would need to know more. I am guessing that your center point will not change coordinates? Say it is at 15,15. If width is 20 and height is 10, then we can easily determine the 0 degree rotated coordinates. If the rotation is 20 degrees, is that counter-clockwise or clockwise? Once that is known, we adjust the original coordinates accordingly. From there, it is fairly easy...

vincentzack
07-12-2016, 04:28 AM
The rotation should be counter-clockwise.

Kenneth Hobs
07-12-2016, 05:49 AM
You can graphically see what I have done so far in this link. I post the link rather than the file as I will work on that file later tonight or this week. https://www.dropbox.com/s/ss9n6j2hz80iiey/DistanceFromPointToRectangle.xlsm?dl=0

I need to work out the 0 degree rotation first. This routine needs a bit more work. It does find the shortest distance from the infinite lines (not line segment) for the sides.

Function Dist2LineSegment(x0 As Double, y0 As Double, Xs As Variant, Ys As Variant) As Double Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double, i As Integer
i = 0
If TypeName(Xs) = "Range" Then i = 1
x1 = Xs(i + 0)
x2 = Xs(i + 1)
y1 = Ys(i + 0)
y2 = Ys(i + 1)
Dist2LineSegment = (Abs((y2 - y1) * x0 - (x2 - x1) * y0 + x2 * y1 - y2 * x1)) / ((y2 - y1) ^ 2 + (x2 - x1) ^ 2) ^ 0.5
End Function

vincentzack
07-12-2016, 05:55 AM
1. Determine the coordinates for each of the line segment ends.
2. Compute distance from point to each of the lines represented by the edge lines or line segments.
3. Return the minimum distance.

If you post an example problem with a known answer, or attach a workbook, we can go from there.

For (2), this should help.

Sub Test_Dist2Line() 'P1 & P2 = points on line. P0= point to check distance from line.
'P0=(x0, y0), (P1(x1, y1), P2(x2, y2). P0(0,0) P1(0,1), P2(1,0).
Debug.Print Dist2Line(0, 0, Array(1, 0), Array(0, 1))
Debug.Print 1 / 2 ^ 0.5
Debug.Print Sin(WorksheetFunction.Radians(45))
End Sub


'http://answers.microsoft.com/en-us/office/forum/office_2010-excel/calculate-the-perpendicular-distance-of-a-point-to/a1f7bbdd-31b9-41b3-afad-fd996a4e8218?auth=1
'https://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line
'Adjusted input order, Kennneth Hobson, July 11, 2016
Function Dist2Line(X As Double, Y As Double, Xs As Variant, Ys As Variant) As Double
'Distance from the point (X,Y) to a straight line with equation Y=A0+A1*X
'A0 and A1 are readily calculated by a linear regression from a series of mark points of the line
Dim A0 As Double, A1 As Double
A0 = WorksheetFunction.Intercept(Ys, Xs)
A1 = WorksheetFunction.Slope(Ys, Xs)
Dist2Line = Abs(A1 * X - Y + A0) / Sqr(A1 * A1 + 1)
End Function




Sub Test_Dist2LineSegment()
'P1 & P2 = points on line. P0= point to check distance from line.
'P0=(x0, y0), (P1(x1, y1), P2(x2, y2). P0(0,0) P1(0,1), P2(1,0).
Debug.Print Dist2LineSegment(0, 0, Array(1, 0), Array(0, 1))
Debug.Print 1 / 2 ^ 0.5
Debug.Print Sin(WorksheetFunction.Radians(45))
End Sub


Function Dist2LineSegment(x0 As Double, y0 As Double, Xs As Variant, Ys As Variant) As Double
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
x1 = Xs(0)
x2 = Xs(1)
y1 = Ys(0)
y2 = Ys(1)
Dist2LineSegment = (Abs((y2 - y1) * x0 - (x2 - x1) * y0 + x2 * y1 - y2 * x1)) / ((y2 - y1) ^ 2 + (x2 - x1) ^ 2) ^ 0.5
End Function

Sub Test_Dist2LineSegment2()
'P1 & P2 = points on line. P0= point to check distance from line.
'Answer is 0, since origin, P0(0,0) is on line P1(1,1) to P2(-1,-1)
Debug.Print Dist2LineSegment(0, 0, Array(1, -1), Array(1, -1))
End Sub


Sub Test_Dist2LineSegment3()
'P1 & P2 = points on line. P0= point to check distance from line.
'Answer is 1.
Debug.Print Dist2LineSegment(0, 0, Array(1, 1), Array(1, -1))
End Sub

Attached data for your reference. All dimensions are in mm. The data obtained from AutoCAD. The rotation is counter-clockwise.

Kenneth Hobs
07-12-2016, 06:05 AM
The data will help. I like to validate solutions against known values. The data is in my file for reference when I get to it again.

Kenneth Hobs
07-12-2016, 11:58 AM
The apex coordinate distances were found to be the minimum for my first example and your first one. To translate your system of rectangular area, select a 5 rows by 2 column range, and enter the formula with the inputs. See my Chart 2 example. Enter as Shift+Ctrl+Enter to enter is a formula array. Of course the math is easy to see as shown in the function below.


The code is:

Function CoordRRect(Xc As Double, Yc As Double, w As Double,
_ h As Double, Optional ccwAngle As Double = 0) As Variant
Dim a() As Variant
ReDim a(1 To 5, 1 To 2)
a(1, 1) = Xc - w / 2
a(1, 2) = Yc - h / 2
a(2, 1) = Xc - w / 2
a(2, 2) = Yc + h / 2
a(3, 1) = Xc + w / 2
a(3, 2) = Yc + h / 2
a(4, 1) = Xc + w / 2
a(4, 2) = Yc - h / 2
a(5, 1) = Xc - w / 2
a(5, 2) = Yc - h / 2
CoordRRect = a()
End Function


Obviously, the rotation adjustments need to be coded as well. More work needs to be done where a point is more near a side than and apex coordinate point.

Kenneth Hobs
07-13-2016, 09:29 AM
The last part left to do is to adjust the coordinates due to the CCW angle of rotation and write a function to do it all with inputs: Point(X0, X1), length, width, and CCW angle of rotation in degrees. The return would be the minimum distance by checking the point distance to each line segment. Precision governs how close one can get.

'http://vb-helper.com/howto_distance_point_to_line.html' Calculate the distance between the point and the segment.
' Modified by Kenneth Hobson, July 13, 2016, moved near_x and near_y from inputs.
Function DistToSegment(ByVal px As Double, ByVal py _
As Double, ByVal X1 As Double, ByVal Y1 As Double, _
ByVal X2 As Double, ByVal Y2 As Double) As Double
Dim dx As Double, dy As Double, t As Double
Dim near_x As Double, near_y As Double


dx = X2 - X1
dy = Y2 - Y1
If dx = 0 And dy = 0 Then
' It's a point not a line segment.
dx = px - X1
dy = py - Y1
near_x = X1
near_y = Y1
DistToSegment = Sqr(dx * dx + dy * dy)
Exit Function
End If


' Calculate the t that minimizes the distance.
t = ((px - X1) * dx + (py - Y1) * dy) / (dx * dx + dy * _
dy)


' See if this represents one of the segment's
' end points or a point in the middle.
If t < 0 Then
dx = px - X1
dy = py - Y1
near_x = X1
near_y = Y1
ElseIf t > 1 Then
dx = px - X2
dy = py - Y2
near_x = X2
near_y = Y2
Else
near_x = X1 + t * dx
near_y = Y1 + t * dy
dx = px - near_x
dy = py - near_y
End If


DistToSegment = Sqr(dx * dx + dy * dy)
End Function

vincentzack
07-14-2016, 05:19 AM
Just an idea...is it possible to rotate the axis and all coordinate to X-Y cartesian coordinate system first? Just like the following website: https://en.wikipedia.org/wiki/Rotation_of_axes

Kenneth Hobs
07-14-2016, 07:01 AM
Part of the concepts shown there helps.

Your rotation problem is more involved though as your centroid is neither at the origin nor origin at bottom left corner. For 0 degree rotation, I call the bottom left corner P1, and going clockwise, P3 would be the top right corner if you look at my charts. Side A is P1 to P2, B is P2 to P3, etc.

This first link explains the 3 step process needed. I like those concepts.
https://www.siggraph.org/education/materials/HyperGraph/modeling/mod_tran/2drota.htm
https://en.wikipedia.org/wiki/Rotation_matrix

I see two paths to do it.
1. =MMult() on a translation of coordinates and then apply a translation using offsets.
2. Use trigonometry on a translated coordinate and then apply offsets to un-rotated coordinates. Of course trigonometry is used a bit in method (1) as well.

I have not decided which method to try first. You can see some of my tests and thinking in the referenced file.

So, be patient, I should be able to solve it by the weekends end or earlier. I just post to show you that I have not forgotten about this.

vincentzack
07-14-2016, 07:26 AM
Thanks a lot!!!

vincentzack
07-18-2016, 05:49 AM
Do anything I can help?

Kenneth Hobs
07-18-2016, 07:52 AM
I asked on ExcelForum if they could suggest some rotation correction formulas. I got one response and am waiting on a clarification so I can try the suggestion.

Otherwise, I finished it. The Data3 sheet shows that it works as expected for 0 rotation and not so much for rotation > 0 degrees.

https://www.dropbox.com/s/ss9n6j2hz80iiey/DistanceFromPointToRectangle.xlsm?dl=0
I'll post the link again if it changes and attach the file if I get or figure out better rotation corrections.

Paul_Hossler
07-18-2016, 09:37 AM
I would seem (to me at least) that the minimum of the 4 distances from the point to each of the line segments would be the shortest, and you wouldn't need to worry about rotation???

'http://stackoverflow.com/questions/849211/shortest-distance-between-a-point-and-a-line-segment



Option Explicit

'4 points with X and Y
Dim Points(1 To 4, 1 To 2) As Double

'the point
Dim X As Double, Y As Double

'distances form (X,Y) to Lx
Dim Distance(1 To 4) As Double

Sub test()
Dim i As Long, j As Long
Dim MinDist As Double

'store points
Points(1, 1) = 10
Points(1, 2) = 10
Points(2, 1) = 20
Points(2, 2) = 20
Points(3, 1) = 30
Points(3, 2) = 5
Points(4, 1) = 25
Points(4, 2) = 0
X = 5
Y = 30

MinDist = -1#

'calc Distances
For i = LBound(Points, 1) To UBound(Points, 1)
j = IIf(i = UBound(Points, 1), LBound(Points, 1), i + 1)
Distance(i) = pDistance(X, Y, Points(i, 1), Points(i, 2), Points(j, 1), Points(j, 2))

Cells(i + 1, 7).Value = Distance(i)

If MinDist = -1# Then
MinDist = Distance(i)
ElseIf MinDist > Distance(i) Then
MinDist = Distance(i)
End If
Next I

MsgBox "Min Distance = " & MinDist

End Sub
Private Function pDistance(X As Double, Y As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim Dot As Double, len_sq As Double
Dim param As Double
Dim xx As Double, yy As Double, dx As Double, dy As Double

A = X - x1
B = Y - y1
C = x2 - x1
D = y2 - y1
Dot = A * C + B * D
len_sq = C * C + D * D
param = -1

If len_sq <> 0# Then 'in case of 0 length line
param = Dot / len_sq
End If
If param < 0# Then
xx = x1
yy = y1
ElseIf param > 1 Then
xx = x2
yy = y2
Else
xx = x1 + param * C
yy = y1 + param * D
End If
dx = X - xx
dy = Y - yy

pDistance = Sqr(dx * dx + dy * dy)
End Function

snb
07-19-2016, 01:41 AM
Maybe you should experiment a little with Excel's built-in calculation:


Sub M_snb()
With Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
With .ConnectorFormat
.BeginConnect Shapes(1), 1
.EndConnect Shapes(2), 8
End With
.RerouteConnections

MsgBox .Width
End With
End Sub

Kenneth Hobs
07-19-2016, 05:46 AM
Paul, when you rotate the rectangle by a ccw angle, the coordinates at the corner points change. The routine that I posted finds the shortest distance just fine. I may or may not have tried the pDistance() routine.

SNB, the rectangle is not a shape as I understand it based on post #9. I was thinking about using a temporary shape to find coordinates but they are not Cartesian coordinates.

Paul_Hossler
07-19-2016, 05:53 AM
Paul, when you rotate the rectangle by a ccw angle, the coordinates at the corner points change. The routine that I posted finds the shortest distance just fine.

I could be interpreting the question wrong

1. From Point to each of the 4 vertices, or from Point to closest approach of the line segments?

vincentzack
07-19-2016, 06:18 AM
Paul, the purpose is the shortest distance to a rectangle, so both cases may happen. It depends on the coordinate of the point.

Kenneth Hobs
07-19-2016, 06:46 AM
Right Paul. The distance closest to the line segment from a point, if not the vertices, is a perpendicular line. I have a solution for that.

The key for the rotated solution is finding the new coordinates of the vertices. For no rotation, I solved that. For the rotation, I am close as you can see from the linked file in #17. I doubt my math as the plot of the rotation seems off to me. It may be scaling issue though.

Vincentzack, are you sure about the minimum distances for the rotated example data?

vincentzack
07-19-2016, 07:08 AM
Kenneth, I uploaded four set data and added two pictures to show the measurement from AutoCAD for your reference.

I'm sorry I can't find the AutocCAD file for the data in the previous example.

Kenneth Hobs
07-19-2016, 07:41 AM
Is your Xa and Ya centroid point the same before and after rotation? The only way they would not would be if you rotated about some other point like point 1, bottom left point of unrotated rectangle.

vincentzack
07-20-2016, 04:30 AM
The Centroid point is always the same and the rotation is about the centroid. I have attached a revised picture to show it.

vincentzack
07-22-2016, 12:20 AM
Is your Xa and Ya centroid point the same before and after rotation? The only way they would not would be if you rotated about some other point like point 1, bottom left point of unrotated rectangle.

Do anything I can help?

Kenneth Hobs
07-22-2016, 01:16 PM
No.

Thinking about this has been tougher than normal since I have been ill. When I get better, I will look at this again.

Kenneth Hobs
07-25-2016, 08:23 PM
Got some meds for my Rocky Mountain Spotted Fever. 103F for 3 days was not fun.

I noticed that your graphics might have been skewed when rotated. Maybe it is just a my loopy eyes. Have you printed those out and laid a protractor over it to see if the rotated angles are still 90 degrees? In any case, I had hoped that this new approach would work. I will chart it tomorrow to see if it at least looks right.

The test sub makes it easy to test your data.

Public Const Pi = 3.14159265358979

Sub Test_MinDistToSegment()
MsgBox MinDistToSegment(500, 800, 1000, 1750, 6000, 3300, 0) '5257.44
MsgBox MinDistToSegment(500, 800, 1000, 1750, 4415.316, 3572.7878, 30) '4127.16
MsgBox MinDistToSegment(500, 800, 1000, 1750, 1472.149, 2793.8736, 30) '2317.46
End Sub


Function MinDistToSegment(Xc As Double, Yc As Double, w As Double, _
h As Double, Xp As Double, Yp As Double, Optional ccwAngle As Double = 0) As Double
Dim a() As Variant, d(1 To 5) As Variant, i As Integer
a() = CoordRect(Xc, Yc, w, h, ccwAngle)
For i = LBound(a) + 1 To UBound(a)
d(i) = DistToSegment(Xp, Yp, a(i - 1, 1), a(i - 1, 2), a(i, 1), a(i, 2))
Next i
MinDistToSegment = WorksheetFunction.Min(d)
End Function




'Rotation adjustments:
'https://www.siggraph.org/education/materials/HyperGraph/modeling/mod_tran/2drota.htm
'https://en.wikipedia.org/wiki/Rotation_matrix
'https://en.wikipedia.org/wiki/Rotation_of_axes
'https://www.khanacademy.org/math/linear-algebra/matrix-transformations/lin-trans-examples/v/linear-transformation-examples-rotations-in-r2


'Created by Kenneth Hobson, July 11, 2016
'Degrees=Radians*180/Pi, Radians=Degrees*pi/180
Function CoordRect(Xc As Double, Yc As Double, w As Double, _
h As Double, Optional ccwAngle As Double = 0) As Variant

Dim a() As Variant, b(1 To 1, 1 To 2) As Variant, aa() As Variant, i As Integer
Dim theta As Double, c As Variant

ReDim a(1 To 5, 1 To 2)
a(1, 1) = Xc - w / 2
a(1, 2) = Yc - h / 2
a(2, 1) = Xc - w / 2
a(2, 2) = Yc + h / 2
a(3, 1) = Xc + w / 2
a(3, 2) = Yc + h / 2
a(4, 1) = Xc + w / 2
a(4, 2) = Yc - h / 2
a(5, 1) = Xc - w / 2
a(5, 2) = Yc - h / 2

If ccwAngle = 0 Then
CoordRect = a()
Exit Function
End If

'Translation needed if ccwAngle<>0

'Fill a same size array with coordinates for the translation adjustments.
aa() = a()

theta = ccwAngle * Pi / 180

For i = 1 To 4
b(1, 1) = a(i, 1)
b(1, 2) = a(i, 2)
c = Rotate(b(), theta, 3)
aa(i, 1) = c(1, 1)
aa(i, 2) = c(1, 2)
Next i
aa(5, 1) = aa(1, 1)
aa(5, 2) = aa(1, 2)
CoordRect = aa()
End Function

'http://vb-helper.com/howto_distance_point_to_line.html
' Calculate the distance between the point and the segment.
' Modified by Kenneth Hobson, July 13, 2016, moved near_x and near_y from inputs.
Function DistToSegment(ByVal px As Double, ByVal py _
As Double, ByVal x1 As Double, ByVal y1 As Double, _
ByVal x2 As Double, ByVal y2 As Double) As Double
Dim dx As Double, dy As Double, t As Double
Dim near_x As Double, near_y As Double


dx = x2 - x1
dy = y2 - y1
If dx = 0 And dy = 0 Then
' It's a point not a line segment.
dx = px - x1
dy = py - y1
near_x = x1
near_y = y1
DistToSegment = Sqr(dx * dx + dy * dy)
Exit Function
End If


' Calculate the t that minimizes the distance.
t = ((px - x1) * dx + (py - y1) * dy) / (dx * dx + dy * _
dy)


' See if this represents one of the segment's
' end points or a point in the middle.
If t < 0 Then
dx = px - x1
dy = py - y1
near_x = x1
near_y = y1
ElseIf t > 1 Then
dx = px - x2
dy = py - y2
near_x = x2
near_y = y2
Else
near_x = x1 + t * dx
near_y = y1 + t * dy
dx = px - near_x
dy = py - near_y
End If


DistToSegment = Sqr(dx * dx + dy * dy)
End Function


'Created by Kenneth Hobson, 7/14/2016
Function lDist(x1, y1, x2, y2) As Double
lDist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
End Function


'https://newtonexcelbach.wordpress.com/2008/08/10/intersections-interpolations-and-rotations/
'http://interactiveds.com.au/software/IP2.ZIP
Public Function Rotate(Rcoords As Variant, Rotation As Double, Axis As Long, _
Optional Result As Long) As Variant
Dim r As Double, theta As Double, Plane(1 To 2) As Long
Dim r1 As Double, r2 As Double


Select Case Axis
Case 1
Plane(1) = 2
Plane(2) = 3
Case 2
Plane(1) = 3
Plane(2) = 1
Case 3
Plane(1) = 1
Plane(2) = 2
Case Else
Rotate = "Invalid Axis"
Exit Function
End Select


If TypeName(Rcoords) = "Range" Then
Rcoords = Rcoords.Value
End If


' Rotate
r1 = Rcoords(1, Plane(1))
r2 = Rcoords(1, Plane(2))
'If Not (r1= 0 And r2= 0) Then
r = r1 ^ 2 + r2 ^ 2 ^ 0.5
theta = ATn2(r1, r2)


theta = theta + Rotation
Rcoords(1, Plane(1)) = r * Cos(theta)
Rcoords(1, Plane(2)) = r * Sin(theta)
'End If


If Result = Empty Then
Rotate = Rcoords
Else
Rotate = Rcoords(1, Result)
End If
End Function


Function ATn2(x As Variant, Y As Variant) As Double
' Inverse tangent based on X and Y coordinates
' X and Y both zero produces an error.
If x = 0 Then
If Y = 0 Then
ATn2 = 1 / 0
ElseIf Y > 0 Then
ATn2 = Pi / 2
Else
ATn2 = -Pi / 2
End If
ElseIf x > 0 Then
If Y = 0 Then
ATn2 = 0
Else
ATn2 = Atn(Y / x)
End If
Else
If Y = 0 Then
ATn2 = Pi
Else
ATn2 = (Pi - Atn(Abs(Y) / Abs(x))) * Sgn(Y)
End If
End If
End Function

Kenneth Hobs
07-26-2016, 09:28 AM
I went back to basics. I added comments should others want to dissect what I did.

I moved Pi to a public constant. It can easily be moved back into the main routine if that is preferred.

Option Explicit

Public Const Pi = 3.14159265358979

Sub Test_MinDistToSegment()
MsgBox MinDistToSegment(500, 800, 1000, 1750, 6000, 3300, 0) '5257.44
MsgBox MinDistToSegment(500, 800, 1000, 1750, 4415.316, 3572.7878, 30) '4277.16, not 4127.16
MsgBox MinDistToSegment(500, 800, 1000, 1750, 1472.149, 2793.8736, 30) '2317.46
End Sub


Function MinDistToSegment(Xc As Double, Yc As Double, w As Double, _
h As Double, Xp As Double, Yp As Double, Optional ccwAngle As Double = 0) As Double
Dim a() As Variant, d(1 To 5) As Variant, i As Integer
a() = CoordRect(Xc, Yc, w, h, ccwAngle)
For i = LBound(a) + 1 To UBound(a)
d(i) = DistToSegment(Xp, Yp, a(i - 1, 1), a(i - 1, 2), a(i, 1), a(i, 2))
Next i
MinDistToSegment = WorksheetFunction.Min(d)
End Function




'Rotation adjustments:
'https://www.siggraph.org/education/materials/HyperGraph/modeling/mod_tran/2drota.htm


'Created by Kenneth Hobson, July 11, 2016, final July 26, 2016
'Degrees=Radians*180/Pi, Radians=Degrees*pi/180
Function CoordRect(Xc As Double, Yc As Double, w As Double, _
h As Double, Optional ccwAngle As Double = 0) As Variant

Dim a(1 To 5, 1 To 2) As Variant

a(1, 1) = Xc - w / 2
a(1, 2) = Yc - h / 2
a(2, 1) = Xc - w / 2
a(2, 2) = Yc + h / 2
a(3, 1) = Xc + w / 2
a(3, 2) = Yc + h / 2
a(4, 1) = Xc + w / 2
a(4, 2) = Yc - h / 2
a(5, 1) = a(1, 1) 'Close loop for chart purposes
a(5, 2) = a(1, 2)

If ccwAngle = 0 Then
CoordRect = a()
Exit Function
End If


'Translation needed if ccwAngle<>0
Dim aOrg() As Variant, aRot(1 To 5, 1 To 2) As Variant
Dim aOff(1 To 5, 1 To 2) As Variant, aFin(1 To 5, 1 To 2) As Variant
Dim phi As Double, i As Integer

'Make phi (radians) = ccwAngle (degrees)
phi = ccwAngle * Pi / 180

'Translate coordinates to origin
aOrg() = CoordRect(0, 0, w, h)

'Rotate coordinates about origin by phi (ccwAngle)
For i = 1 To 5
aRot(i, 1) = aOrg(i, 1) * Cos(phi) - aOrg(i, 2) * Sin(phi) 'xPrime
aRot(i, 2) = aOrg(i, 1) * Sin(phi) + aOrg(i, 2) * Cos(phi) 'yPrime
Next i

'Determine offsets (dx, dy) - changes [aRot() - aOrg()]
For i = 1 To 5
aOff(i, 1) = aRot(i, 1) - aOrg(i, 1) 'dx
aOff(i, 2) = aRot(i, 2) - aOrg(i, 2) 'dy
Next i

'Translate rotation back to final coordinates - [a() + aOff()]
For i = 1 To 5
aFin(i, 1) = a(i, 1) + aOff(i, 1) 'Final X
aFin(i, 2) = a(i, 2) + aOff(i, 2) 'Final Y
Next i

CoordRect = aFin()
End Function


'http://vb-helper.com/howto_distance_point_to_line.html
' Calculate the distance between the point and the segment.
' Modified by Kenneth Hobson, July 13, 2016, moved near_x and near_y from inputs.
Function DistToSegment(ByVal px As Double, ByVal py _
As Double, ByVal x1 As Double, ByVal y1 As Double, _
ByVal x2 As Double, ByVal y2 As Double) As Double

Dim dx As Double, dy As Double, t As Double
Dim near_x As Double, near_y As Double


dx = x2 - x1
dy = y2 - y1
If dx = 0 And dy = 0 Then
' It's a point not a line segment.
dx = px - x1
dy = py - y1
near_x = x1
near_y = y1
DistToSegment = Sqr(dx * dx + dy * dy)
Exit Function
End If


' Calculate the t that minimizes the distance.
t = ((px - x1) * dx + (py - y1) * dy) / (dx * dx + dy * dy)


' See if this represents one of the segment's
' end points or a point in the middle.
If t < 0 Then
dx = px - x1
dy = py - y1
near_x = x1
near_y = y1
ElseIf t > 1 Then
dx = px - x2
dy = py - y2
near_x = x2
near_y = y2
Else
near_x = x1 + t * dx
near_y = y1 + t * dy
dx = px - near_x
dy = py - near_y
End If


DistToSegment = Sqr(dx * dx + dy * dy)
End Function


This looks really close. There are some points that don't compare though like A3 and A4.



Area
Width
Height
Centroid
Rotation

Point

Known Shortest Distance (mm)
Compute Shortest Distance (mm)



mm
mm
XA
YA

XP
YP



A1
1000
1750
500
800
0

6000
3300

5257.44
5257.44


A1
1000
1750
500
800
0

5682.4184
1337.36

4682.42
4682.42
















A2
1000
1750
500
800
30

4415.316
3272.7878

4127.16
4127.16


A2
1000
1750
500
800
30

6117.49
-854.4969

4883.53
4883.52
















A5
2000
1500
1000
750
25

2086.8046
4519.9881

2713.63
2713.63


A5
2000
1500
1000
750
25

-307.3148
2185.206

1103.23
1103.23
















A3
1000
1750
500
800
30

1472.149
2793.8736

2317.46
1387.88


A3
1000
1750
500
800
30

1086.521
-2094.9305

1482.52
1974.87
















A4
1000
1750
500
800
52

-2220.9192
1977.2259

2092.41
2009.19


A4.
1000
1750
500
800
52

-3337.5962
-229.9044

2370.05
3073.56

vincentzack
08-01-2016, 06:42 AM
Thank you very much! Your function is excellent!!!!!~~~:thumb