CCW Rotated Coordinates of a Rectangle?

I have looked at this too long I guess. The last part needed to help a user at the link is to determine the coordinates of the counter-clockwise (CCW) rotated rectangle.
http://www.vbaexpress.com/forum/show...-and-rectangle

Example inputs: Centroid x=500 and y=800, width=1000, height=1750, and rotation=30 degrees CCW.

The rotation seems a bit off. If you have any suggestions, please let me know.

For testing, I use this as a UDF array formula. e.g. =coordrect(D35,E35,B35,C35,F35)

I looked at several ways to do it.

See the function below or see the attached file's routine in mMain module. The example data with a chart is in sheet Chart4. The unrotated chart is in sheet Chart3. I manually looked at =MMult() in the last sheet.

'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
  
  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
  Dim phi As Double, theta As Double, pt As Double, r As Double
  Dim xPrime As Double, yPrime As Double
  Dim dx As Double, dy As Double, aa() As Variant
  Dim i As Integer
  
  Const Pi = 3.14159265358979
  Const mfD2R = Pi / 180 'Multipying Factor for Degrees to Radians
  
  'r = radius or 1/2 length of rectangle's diagonal length.
  r = lDist(0, 0, w / 2, h / 2)
  'Theta in radians. Initial angle of rectangle's diagonal.
  theta = WorksheetFunction.Atan2(w, h)
  'Counter-Clock-Wise (CCW) angle in radians.
  'phi = mfD2R * ccwAngle
  phi = WorksheetFunction.Radians(ccwAngle)
  pt = phi
  
  
  'Using centroid at origin coordinate (0,0).
  'Find P3 (upper right corner of rectangle) coordinates.
  xPrime = r * Cos(pt)
  yPrime = r * Sin(pt)
  'Same result as above:
  'xPrime = w / 2 * Cos(phi) - h / 2 * Sin(phi)
  'yPrime = h / 2 * Cos(phi) + w / 2 * Sin(phi)
  
  'Find the x and y offset or change in x and y due to rotation.
  dx = Abs(w / 2 - xPrime)
  dy = Abs(h / 2 - yPrime)
  
  'Fill a same size array with coordinates for the translation adjustments.
  aa() = a()
  
  'aa(1, 1) = a(1, 1) + dx
  'aa(1, 2) = a(1, 2) - dy
  'aa(2, 1) = a(2, 1) - dx
  'aa(2, 2) = a(2, 2) - dy
  'aa(3, 1) = a(3, 1) - dx
  'aa(3, 2) = a(3, 2) + dy
  'aa(4, 1) = a(4, 1) + dx
  'aa(4, 2) = a(4, 2) + dy
  'aa(5, 1) = a(5, 1) + dx
  'aa(5, 2) = a(5, 2) - dy
  
  aa(1, 1) = a(1, 1) * Cos(pt) - a(1, 2) * Sin(pt)
  aa(1, 2) = a(1, 1) * Sin(pt) + a(1, 2) * Cos(pt)
  aa(2, 1) = a(2, 1) * Cos(pt) - a(2, 2) * Sin(pt)
  aa(2, 2) = a(2, 1) * Sin(pt) + a(2, 2) * Cos(pt)
  aa(3, 1) = a(3, 1) * Cos(pt) - a(3, 2) * Sin(pt)
  aa(3, 2) = a(3, 1) * Sin(pt) + a(3, 2) * Cos(pt)
  aa(4, 1) = a(4, 1) * Cos(pt) - a(4, 2) * Sin(pt)
  aa(4, 2) = a(4, 1) * Sin(pt) + a(4, 2) * Cos(pt)
  aa(5, 1) = aa(1, 1)
  aa(5, 2) = aa(1, 2)
  
 
  'Debug.Print ccwAngle, dx, dy
  'Debug.Print theta, phi, xPrime, yPrime
  'Debug.Print "r", r
  CoordRect = aa()
End Function

Thanks for the response. I think that you have some typos in those like commas and pi which you meant as phi? You also did not show equalities. Can you make those into xprime=x and yprime=y where xprime and yprime are the values for each coordinate and x and y are the formulas?

I defined theta as the angle to rotate and phi as the existing angle. I simplified my routine to standard rcos rsin formulas. If you manually poke the values or use my UDF as an array formula, it should plot right. This seems right equation-wise which apparently is not since the plot is a parallelogram rather than a rotated rectangle. The plot may be off due to scaling though.

This is my more simplified UDF.

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
  
  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
  Dim phi As Double, theta As Double, pt As Double, r As Double
  Dim xPrime As Double, yPrime As Double
  Dim dx As Double, dy As Double, aa() As Variant
  Dim i As Integer
  
  Const Pi = 3.14159265358979
  Const mfD2R = Pi / 180 'Multipying Factor for Degrees to Radians
  Const mfR2D = 180 / Pi 'Multipying Factor for Radians to Degrees
  
  'r = radius or 1/2 length of rectangle's diagonal length.
  'r = lDist(0, 0, w, h)
  'Theta in radians. Initial angle of rectangle's diagonal.
  theta = WorksheetFunction.Atan2(w, h)
  'Counter-Clock-Wise (CCW) angle in radians.
  'phi = mfD2R * ccwAngle
  phi = WorksheetFunction.Radians(ccwAngle)
  
  'Fill a same size array with coordinates for the translation adjustments.
  aa() = a()
  
  r = lDist(0, 0, a(1, 1), a(1, 2))
  pt = phi + WorksheetFunction.Atan2(a(1, 1), a(1, 2))
  aa(1, 1) = r * Cos(pt)
  aa(1, 2) = r * Sin(pt)
  r = lDist(0, 0, a(2, 1), a(2, 2))
  pt = phi + WorksheetFunction.Atan2(a(2, 1), a(2, 2))
  aa(2, 1) = r * Cos(pt)
  aa(2, 2) = r * Sin(pt)
  r = lDist(0, 0, a(3, 1), a(3, 2))
  pt = phi + WorksheetFunction.Atan2(a(3, 1), a(3, 2))
  aa(3, 1) = r * Cos(pt)
  aa(3, 2) = r * Sin(pt)
  r = lDist(0, 0, a(4, 1), a(4, 2))
  pt = phi + WorksheetFunction.Atan2(a(4, 1), a(4, 2))
  aa(4, 1) = r * Cos(pt)
  aa(4, 2) = r * Sin(pt)
  aa(5, 1) = aa(1, 1)
  aa(5, 2) = aa(1, 2)

  CoordRect = aa()
End Function

Function lDist(x1, y1, x2, y2) As Double
    lDist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
End Function

Yes, I used to do pi that way as well.

I have been ill and finally got well enough to solve this.

Public Const Pi = 3.14159265358979

'http://www.vbaexpress.com/forum/showthread.php?56547-Calculate-distance-between-point-and-rectangle

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
    
  'Fill a same size array with coordinates for the translation adjustments.
  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 from aRot() to 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

Data check:

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