3D Rotations for a Cube

Veikko Keränen 2007
Rovaniemi Polytechnic
School of Technology
veikko.keranen@ramk.fi

Matrices for rotations in plane

Off[General::spell]

Off[General::spell1]

Clear[xy2RotMat,z3RotMat,y3RotMat,x3RotMat];
  
xy2RotMat[phi_] :=
 {{Cos[-phi], Sin[-phi]},
  {-Sin[-phi],Cos[-phi]}};
  
z3RotMat[phi_] :=
 {{Cos[-phi], Sin[-phi],0},
  {-Sin[-phi],Cos[-phi],0},
  {0,0,1}};
  
y3RotMat[phi_] :=
 {{Cos[-phi],0,-Sin[-phi]},
  {0,1,0},
  {Sin[-phi],0,Cos[-phi]}};
  
x3RotMat[phi_] :=
 {{1,0,0},
 {0,Cos[-phi], Sin[-phi]},
 {0,-Sin[-phi],Cos[-phi]}};

M.X
Dot[M,#]& /@ listOfPoints

Define rotation functions for lists

Clear[z2rot,z3rot,y3rot,x3rot];
  
z2rot[phi_,pts2_] := 
  (Dot[xy2RotMat[phi],#]& /@ pts2);
 
(* pts2 is a list of 2-vectors i.e. 
   pts2 is a list of the form {{x1,y1},{x2,y2},...,{xn,yn}} *)
 
z3rot[phi_,pts3_] := (Dot[z3RotMat[phi],#]& /@ pts3);
y3rot[phi_,pts3_] := (Dot[y3RotMat[phi],#]& /@ pts3);
x3rot[phi_,pts3_] := (Dot[x3RotMat[phi],#]& /@ pts3);

/@ is an abbreviation for the Map function.
Map in turn means "Multiply Apply":

Map[g, {a,b,c}  ]
g /@ {a,b,c}

Pure function, notations:  #, & 

A pure function is a nameless operation.

((#)^2)+((#)^3) & [ argument ]

(((#)^2)+((#)^3) )& /@  {a,b,c}

Power[2,2,2,2]

Power[#,#,#,#]&  /@ {a,b,c,2}

Map[ ((#)^2)&, {a,b,c} ]

cubeVertices = {p1,p2,p3,p4,p5,p6,p7,p8} =
 {{1,1,1},{1,-1,1},{1,-1,-1},{1,1,-1},
  {-1,1,1},{-1,-1,1},{-1,-1,-1},{-1,1,-1}};

Point[{1,1,1}]

Clear[myPointShow];
myPointShow[pts_,d_:1] :=
 Show[Graphics3D[{PointSize[0.03], Point /@ pts}],
   BoxRatios->{1,1,1},
   Axes->True,
   AxesLabel->(StyleForm[#,"Subtitle",
   FontWeight ->"Bold"]& /@ {"x","y","z"}),
   PlotRange->{{-2,2},{-2,2},{-2,2}},
   ViewPoint->{2.050,0.830,0.690},
   DisplayFunction->
   If[d==1,$DisplayFunction,Identity]]

$TextStyle = {FontFamily -> "Courier", FontWeight ->"Bold",FontSize->14};

myPointShow[cubeVertices]

InputForm[%]

cubeVertices

myPointShow[x3rot[Pi/8,cubeVertices]]

Thread[List[{a,b,c},{x,y,z}]]

Transpose[{{a,b,c},{x,y,z}}]

myPolygonShow[d_:1] :=
 Show[Graphics3D[Thread[List[
	{RGBColor[0,1,0],RGBColor[0,0,1],
	 RGBColor[0.5,0,0],RGBColor[0,0,0.5],
	 RGBColor[1,0,0],RGBColor[0,0.5,0]},
	(Polygon /@ 
	{{p1,p2,p3,p4},{p1,p2,p6,p5},
     {p2,p3,p7,p6},{p3,p4,p8,p7},
	 {p4,p1,p5,p8},{p5,p6,p7,p8}})]]],
    BoxRatios->{1,1,1},
    Axes->True,AxesLabel->{"x","y","z"},
   PlotRange->{{-2,2},{-2,2},{-2,2}},
   ViewPoint->{2.050,0.830,0.690},
   DisplayFunction->
   If[d==1,$DisplayFunction,Identity]]

Show[myPointShow[
 {p1,p2,p3,p4,p5,p6,p7,p8},0],
 myPolygonShow[0],
 DisplayFunction->$DisplayFunction,
 Lighting->False]

pts={p1,p2,p3,p4,p5,p6,p7,p8} = x3rot[-π/6,cubeVertices];
{p1,p2,p3,p4,p5,p6,p7,p8} = z3rot[0,pts];
Show[myPointShow[{p1,p2,p3,p4,p5,p6,p7,p8},0],
 myPolygonShow[0],
 DisplayFunction->$DisplayFunction,
 Lighting->False]

Clear[rotateAll];
rotateAll[xDeg_,yDeg_,zDeg_]:=
(
pts = x3rot[π*xDeg/180,cubeVertices];
pts = y3rot[π*yDeg/180,pts];
{p1,p2,p3,p4,p5,p6,p7,p8}=pts=
 z3rot[π*zDeg/180,pts];
Show[myPointShow[pts,0],
 myPolygonShow[0],
 DisplayFunction->$DisplayFunction,
 Lighting->False]
 )

rotateAll[10,0,90]