q1={4,{2,0,-1}}
q2={1,{-2,3,1}}

Qprod[q1_,q2_]:={q1[[1]]*q2[[1]]-q1[[2]].q2[[2]], Cross[q1[[2]],q2[[2]]]+q1[[1]]*q2[[2]]+q2[[1]]*q1[[2]]}

Qprod[q1,q2]

Qnorm[q_]:=Sqrt[q[[1]]^2+q[[2]].q[[2]]]
Qnorm2[q_]:=q[[1]]^2+q[[2]].q[[2]]

Qnorm[q1]
Qnorm2[q1]

Qcon[q_]:={q[[1]],-q[[2]]}

Qprod[q1,Qcon[q1]]
Qprod[Qcon[q1],q1]

Qrot[q_,v_]:=Qprod[Qprod[q,v],Qcon[q]]/Qnorm2[q]

v={0,{1,2,3}}

Qrot[q1,v]

q={s,{x,y,z}}

A=Transpose[{Qrot[q,{0,{1,0,0}}][[2]],Qrot[q,{0,{0,1,0}}][[2]],Qrot[q,{0,{0,0,1}}][[2]]}]
MatrixForm[A]

raketa  = ExampleData[{"Geometry3D","SpaceShuttle"}];
pnts = raketa[[1]][[2]][[1]];
For[i=1,i≤Length[pnts],i++,pnts[[i]][[1]]=-pnts[[i]][[1]]];
triangles=Join[raketa[[1]][[2]][[2]][[1]][[1]],raketa[[1]][[2]][[2]][[2]][[1]]];

n={1,2,2}/3
q0={1,{0,0,0}}
q1={Cos[α/2],Sin[α/2]*n}
q=q1 (* přesun do pevné pozice *)
(*
q=(1-t)*q0+t*q1 (* Lerp *) 
θ=ArcCos[Flatten[q0].Flatten[q1]]
q=(Sin[(1-t)θ]*q0+Sin[(t)θ]*q1)/Sin[θ](* Slerp - pouze pro jednotkové  *) 
q=(1-t)^2*q0+2*t*(1-t)*{2,{1,-1,2}}+  t^2*q1 (* Polynomiální přechod *)
*)
M=Transpose[{Factor[Qrot[q,{0,{1,0,0}}]][[2]],Factor[Qrot[q,{0,{0,1,0}}]][[2]],Factor[Qrot[q,{0,{0,0,1}}]][[2]]}];
MatrixForm[Simplify[M]]
pntsMoving=Transpose[M.Transpose[pnts]];

Manipulate[
Show[Graphics3D[{EdgeForm[],Green,GraphicsComplex[pnts, Polygon[triangles]]},Boxed->False, Axes->False, ViewPoint->{1,-1,1}],
Graphics3D[{EdgeForm[],Red,GraphicsComplex[pntsMoving/.{t->1}, Polygon[triangles]]},Boxed->False, Axes->False, ViewPoint->{1,-1,1}],Graphics3D[{Thickness[0.01],Arrow[{{0,0,0},5*n}]}], Graphics3D[{EdgeForm[],GraphicsComplex[pntsMoving/.{t->s}, Polygon[triangles]]},Boxed->False, Axes->False, ViewPoint->{1,-1,1}],  PlotRange->{{-10,10},{-10,10},{-10,10}},Boxed->True],{s, 0, 1}]