3d Rotation of coordinates
The VBA code below rotates xyz coordinates in the cells B2 to D4 as an array about the xyz axes. The three Euler rotation angles are given in the cells
F2,G2,H2. The command:=RotpointsX(RotpointsY(RotpointsZ(AsArray($B2:$D4),$H2),$G2),$F2) carries out the rotation of the array about first the X then Y then Z axes. The command must be placed in cells J2:L4 with ctrl-shift-enter.
The rotated coordinates using this array command are found in cells J2:L4
My question is how can I change this code to allow the rotation angles given in F2,G2,H2 to be changed in row 3 , row 4 etc. In other words to enable each row of input coordinates to be rotated by different Euler angles for every row. The array function is probably not necessary as what I want is to take the coordinates per row in the columns B,C,D and using the angles in F,G,H output the rotated coordinates in J,K,L
Input Euler Angles Output
B C D F G H J K L
x y z tx ty tz x' y' z'
1 2 3 -0.3 -0.2 0.1 0.1834 2.9121 2.3422
1.1 1.9 2.5 0.3901 2.6882 1.9213
1.2 1.8 2.1 0.5769 2.4932 1.5940
VBA Code for above:
F2,G2,H2. The command:=RotpointsX(RotpointsY(RotpointsZ(AsArray($B2:$D4),$H2),$G2),$F2) carries out the rotation of the array about first the X then Y then Z axes. The command must be placed in cells J2:L4 with ctrl-shift-enter.
The rotated coordinates using this array command are found in cells J2:L4
My question is how can I change this code to allow the rotation angles given in F2,G2,H2 to be changed in row 3 , row 4 etc. In other words to enable each row of input coordinates to be rotated by different Euler angles for every row. The array function is probably not necessary as what I want is to take the coordinates per row in the columns B,C,D and using the angles in F,G,H output the rotated coordinates in J,K,L
Input Euler Angles Output
B C D F G H J K L
x y z tx ty tz x' y' z'
1 2 3 -0.3 -0.2 0.1 0.1834 2.9121 2.3422
1.1 1.9 2.5 0.3901 2.6882 1.9213
1.2 1.8 2.1 0.5769 2.4932 1.5940
VBA Code for above:
Code:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Dim n As Integer
n = UBound(pts, 1)
If UBound(pts, 2) <> 3 Then
'Need Three Points
Exit Function
End If
Dim tX As Double, tY As Double, tZ As Double
Dim X As Double, Y As Double, Z As Double
For I = 1 To n
tX = pts(I, 1): tY = pts(I, 2): tZ = pts(I, 3)
X = tX
Y = tY * Cos(angle_rad) - tZ * Sin(angle_rad)
Z = tY * Sin(angle_rad) + tZ * Cos(angle_rad)
pts(I, 1) = X: pts(I, 2) = Y: pts(I, 3) = Z
Next I
RotPointsX = pts
End Function
Public Function RotPointsY(ByRef pts() As Variant, angle_rad As Double) As Variant()
Dim n As Integer
n = UBound(pts, 1)
If UBound(pts, 2) <> 3 Then
'Need Three Points
Exit Function
End If
Dim tX As Double, tY As Double, tZ As Double
Dim X As Double, Y As Double, Z As Double
For I = 1 To n
tX = pts(I, 1): tY = pts(I, 2): tZ = pts(I, 3)
X = tZ * Sin(angle_rad) + tX * Cos(angle_rad)
Y = tY
Z = tZ * Cos(angle_rad) - tX * Sin(angle_rad)
pts(I, 1) = X: pts(I, 2) = Y: pts(I, 3) = Z
Next I
RotPointsY = pts
End Function
Public Function RotPointsZ(ByRef pts() As Variant, angle_rad As Double) As Variant()
Dim n As Integer
n = UBound(pts, 1)
If UBound(pts, 2) <> 3 Then
'Need Three Points
Exit Function
End If
Dim tX As Double, tY As Double, tZ As Double
Dim X As Double, Y As Double, Z As Double
For I = 1 To n
tX = pts(I, 1): tY = pts(I, 2): tZ = pts(I, 3)
X = tX * Cos(angle_rad) - tY * Sin(angle_rad)
Y = tX * Sin(angle_rad) + tY * Cos(angle_rad)
Z = tZ
pts(I, 1) = X: pts(I, 2) = Y: pts(I, 3) = Z
Next I
RotPointsZ = pts
End Function
'Next I need a function to convert a range into an array, and the easiest way to do this with this function:
Public Function AsArray(ByVal r_pts As Range) As Variant()
AsArray = r_pts.Value2
End Function</code>