<Automatic, Axes->True])] boo=Table[circexhib[{5,3,14},{12,5,15} ,25,i],{i,1,25}] Show[Graphics3D[Polygon[{{0,0,0},{1,0,0},{0,1,0}}]],AspectRatio->Automatic, Axes->True] Show[Graphics3D[ { Polygon[{{0,0,0},{1,0,0},{0,1,0}}] , Polygon[{{0,0,0},{0,1,0},{0,0,1}}] , Polygon[{{0,0,0},{1,0,0},{0,0,1}}], Polygon[{{0,0,1},{1,0,0},{0,1,0}}] }] ,AspectRatio->Automatic, Axes->True] tetra={{{0,0,0},{1,0,0},{0,1,0}}, {{0,0,0},{0,1,0},{0,0,1}}, {{0,0,0},{1,0,0},{0,0,1}}, {{0,0,1},{1,0,0},{0,1,0}}} trans[obj_,V_]:=Table[ V+obj[[i]][[j]], {i,1,Length[obj]},{j,1,Length[obj[[i]]]}] ntetra=trans[tetra,{1,1,1}] dispobj[obj_,H_,A_,B_,C_]:=Show[Graphics3D[ { {Thickness[.003],Hue[.8],Line[{{0,0,0},{H,0,0}}]}, {Thickness[.003],Hue[.8],Line[{{0,0,0},{0,H,0}}]}, {Thickness[.003],Hue[.8],Line[{{0,0,0},{0,0,H}}]}, {Thickness[.003],Hue[.8],Line[{{0,0,0},{A,B,C}}]}, obj}] ,AspectRatio->Automatic, Axes->True] dispobj[Map[Polygon,ntetra],3,3,3,3] GENROT[obj_,A_,B_,C_,alpha_]:= Block[{ut,rotobj,i,j}, (rotobj= Table[ROTPT[obj[[i]][[j]],A,B,C,alpha], {i,1,Length[obj]},{j,1,Length[obj[[i]]]}]; ut=Map[Polygon,rotobj]; Return[ut])] Table[dispobj[ GENROT[ntetra,3,3,3,i Pi/50] ,3,3,3,3], {i,0,50}] rotmat[A_,B_,C_,alpha_]:=Block[{x,y,z,mat,rx,ry,rz,V}, (V=ROTPT[{x,y,z},A,B,C,alpha]; rx=Coefficient[V,x]; ry=Coefficient[V,y]; rz=Coefficient[V,z]; mat=Transpose[{rx,ry,rz}]; Return[mat])] E11=Cos[a] E1+ Sin[a]E2 E12=-Sin[a] E1+Cos[a]E2 E13=E3 E21=E11 E22=Collect[Cos[b] E12+ Sin[b]E13,{E1,E2,E3}] E23=Collect[-Sin[b] E12+Cos[b]E13,{E1,E2,E3}] E31=Cos[c] E21+ Sin[c]E22 E32=-Sin[c] E21+Cos[c]E22 E33=E23 Collect[E31,{E1,E2,E3}] Collect[E32,{E1,E2,E3}] Collect[E33,{E1,E2,E3}] P3=x E31 +y E32 +z E33 Collect[Coefficient[P3,E1],{x,y,z}] Collect[Coefficient[P3,E2],{x,y,z}] Collect[Coefficient[P3,E3],{x,y,z}]