Rotación de un Tetraedro con respecto a los ejes coordenados

Descargar como Notebook

En Mathematica podemos dibujar un tetraedro utilizando dentro del comando Graphics3D[ ] el comando Tetrahedron[ ] donde se especifican los cuatro vértices de la figura,

Graphics3D[Tetrahedron[{{1, 0, 0},{1, 0, 1},{1, 1, 1},{0, 0, 1}}]]

Para realizar una rotación con respecto, por ejemplo al eje X, multiplicamos cada uno de los vértices del tetraedro por la matriz rx:

rx = {{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}

{{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}

Obteniendo :

rx.{2, 3, 4}

{2, 3 Cos[θ] - 4 Sin[θ], 4 Cos[θ] + 3 Sin[θ]}

Ahora, en general definimos por lista los vértices del tetraedro inicial y las matrices de rotación como funciones del ángulo de rotación por: rox, roy y roz.

lista = {{1, 2, 2}, {1, 0, 1}, {1, 1, 1}, {0, 0, 1}};
rox[θ_] := {{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}; 
roy[θ_] := {{Cos[θ], 0, -Sin[θ]}, {0, 1, 0}, {Sin[θ], 0, Cos[θ]}}; 
roz[θ_] := {{Cos[θ], -Sin[θ], 0}, {Sin[θ], Cos[θ], 0}, {0, 0, 1}};
Manipulate[rot[aa_] := Dot[r[θ], aa]; 
 Show[Graphics3D[Tetrahedron[lista], AxesOrigin -> {0, 0, 0}, 
   Axes -> True, AxesStyle -> Directive[Orange, 12], 
   AxesLabel -> {"X", "Y", "Z"}, PlotRange -> 3], 
  Graphics3D[Tetrahedron[Map[rot, lista]]]], {{θ, Pi/4, 
   "Angulo"}, 0, 
  2 Pi}, {{r, rox, "Rotación"}, {rox -> "Eje X", roy -> "Eje Y", 
   roz -> "Eje Z"}}]

Creación del GIF

Export[NotebookDirectory[] <> "tetra.gif", 
 Manipulate[rot[aa_] := Dot[r[θ], aa]; 
 Show[Graphics3D[Tetrahedron[lista], AxesOrigin -> {0, 0, 0}, 
   Axes -> True, AxesStyle -> Directive[Orange, 12], 
   AxesLabel -> {"X", "Y", "Z"}, PlotRange -> 3], 
  Graphics3D[Tetrahedron[Map[rot, lista]]]], {{θ, Pi/4, 
   "Angulo"}, 0, 
  2 Pi}, {{r, rox, "Rotación"}, {rox -> "Eje X", roy -> "Eje Y", 
   roz -> "Eje Z"}}], "AnimationRepetitions" -> Infinity]


Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas