Изменение 3D-системы координат с помощью Excel

Пытаюсь ответить, разделив задание на 5 частей. Я буду называть x,y,z старой осью с центром в O, а X,Y,Z вашей новой осью с центром в P.

Попробуйте сохранить частичный результат в пустых ячейках с первой попытки. Я не могу дать вам единственную уникальную формулу, которая ответит на ваш вопрос за 1 шаг.

а) Родовое преобразование — это ротоперевод. Вы нашли свое новое начало в точке P (координаты у вас есть). Предполагая, что ваш «старый источник» равен O = (0,0,0), я могу просто сказать, что перевод из старого источника в новый равен d = |P-O| = |П| евклидова норма вектора P в обеих системах, и ее довольно легко вычислить в excel (я не знаю, есть ли функция, я бы использовал теорему Пифагора). Кто-то пытается создать пользовательский макрос здесь

б) Теперь, когда у вас есть вектор смещения (t1,t2,t3), вы можете установить новое начало координат для старой оси, не поворачивая их. Обратите внимание на знак, но это простая формула перевода (см. пример: если x = x' + t1, то x' = x - t1) Подумайте, что такое x' и что такое x в вашем случае, попробуйте с простой точкой (1,0,0) и посмотрите, удачен ли ваш выбор. Сделайте перевод всех ваших точек (например: PT1_t, PT2_t...) Теперь у вас есть промежуточная система отсчета между xyz и XYZ. Назовем это "pqr"

в) Теперь ваши системы отсчета pqr и XYZ отличаются только углом поворота. Вы должны решить, какая ось будет вращаться первой, прежде чем строить матрицу вращения. Лучше работать с нормализованным вектором (разделить каждый вектор на его норму). Предположим, что вращение из системы pqr и XYZ представляет собой композицию (не более) 3 вращений вокруг фиксированной оси. Например

1. вы повернете pqr вокруг Z, чтобы поместить versor p в плоскость XZ. вы получите «новую» систему pqr. Это делается с помощью матрицы вращения 3x3 RX (мы этого еще не знаем)
2. вы будете вращать pqr' вокруг Y, чтобы выровнять versor p' с versor X, используя RY. Теперь у вас есть pqr''
3. вы выровняете ось q по Y и ось r по Z, используя вращение вокруг X и матрицу RX. pqr''' полностью выровнен по XYZ

Полный оборот равен R = RX * RY * RZ, матричному произведению. Как найти вращение? (Следование моей последовательности вращения не является обязательным! Вы можете построить свою собственную последовательность, но наиболее известны XYZ, ZYX и ZXZ).

г) Каждой матрице нужен угол. Первый угол — это угол между p и его проекцией на плоскость XZ. Второй угол - это угол между p' (=RZ * p) и X, третий угол - между q'' (=RY * q' = RY * RX * q) и Y. Он должен быть равен (с ошибками) к углу между r'' и Z. Матрица может быть построена так (если A - общий угол)

RX = [1   0      0
      0 cos(A) -sin(A)
      0 sin(A) cos(A)]

проверьте RY и RZ по этой ссылке, но обратите внимание: как мы уже говорили ранее, A — это угол поворота в одном направлении, поэтому вам может понадобиться -A для вашего вращения. В общем (но проверьте это) A - это угол ОТ старой оси ДО новой, а положительный A - против часовой стрелки.

Чтобы вычислить угол A, используйте простую формулу приведенную здесь. В Excel есть все гониометрические формулы (косинус, арккосинус...), которые вам нужны.

e) Как только вы нашли три матрицы RX RY RZ, играющие с вращением старой оси pqr, каждая отдельная точка PTi' в вашей новой системе XYZ получается из PTi' = R * PTi_t. Вы можете просто создать матричный продукт с помощью функции Excel MMULT, объясненной здесь

Извините за длину, но это единственная система, которую я знаю как простой студент. Я надеюсь, что это может помочь вам.

Требуется команда от J6 до L16 ниже с помощью Ctrl+Shift+Enter для сброса координат до исходных значений

=RotpointsZ(RotpointsY(RotpointsX(AsArray($F$6:$H$16),$K$1),$K$2),$K$3)

Как я могу отредактировать код VBA, чтобы считывать разные повороты xyz для каждой повернутой строки вместо привязки к одному повороту, как показано здесь?

26/04/18 WORF на Mr.Excel только что ответил на мой вопрос о чтении разных поворотов xyz для каждой точки, которую нужно повернуть. Его ввод состоял в том, чтобы добавить следующий код к существующему коду:

Function Rot3D(ByVal rng1 As Range, ByVal rng2 As Range, ByVal rng3 As 
Range, ByVal rng4 As Range)
Rot3D = RotPointsX(RotPointsY(RotPointsZ(AsArray(rng1), rng2.Value), 
rng3.Value), rng4.Value)
End Function

Скопируйте следующую формулу:

=rot3d(b2:d2,h2,g2,f2)

в ячейки J2,K2,L2, используя Ctrl+Shift+Enter, а затем скопируйте вниз. Вращение координат xyz в столбцах B,C,D будет повернуто в соответствии с углами в столбцах F,G,H с выводом в столбцах J,K,L

Я поместил углы поворота в столбцы F, G, H, используя вырезание и вставку. Это, конечно, изменяет макет исходного листа, который отображается здесь.

Взгляните на этот код, который позволяет вращать диапазон точек, упорядоченных по строкам.

Public Function RotPointsX(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
        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

Public Function AsArray(ByVal r_pts As Range) As Variant()
    AsArray = r_pts.Value2
End Function

=RotPointsX(
     RotPointsY(
         RotPointsZ(
             AsArray(<range>),
         angle_z),
     angle_y), 
 angle_x)

=RotPointsZ(
     RotPointsY(
         RotPointsX(
             AsArray(<range>),
         -angle_x),
     -angle_y), 
 -angle_z)