projection of {-1,1}*{-1,1} to a ruled tetrahedral surface in rectangles
- To: mathgroup at smc.vnet.net
- Subject: [mg52709] projection of {-1,1}*{-1,1} to a ruled tetrahedral surface in rectangles
- From: Roger Bagula <tftn at earthlink.net>
- Date: Thu, 9 Dec 2004 20:24:02 -0500 (EST)
- Reply-to: tftn at earthlink.net
- Sender: owner-wri-mathgroup at wolfram.com
Clear[x,y,a,g,p,k]
(* projection of {-1,1}*{-1,1} to a ruled tetrahedral surface in
rectangles*)
x[t_,p_]:=(1-p)*Cos[t]/Max[Abs[Cos[t]],Abs[Sin[t]]]
y[t_,p_]:=(1+p)*Sin[t]/Max[Abs[Cos[t]],Abs[Sin[t]]]
p=(k+1)/10
g=Table[ParametricPlot[{x[t,p],y[t,p]},{t,-Pi,Pi},
PlotRange->{{-1.25,1.25},{-1.25,1.25}}],{k,0,8}];
Show[g,PlotRange->All]
ga=ParametricPlot3D[{x[Pi*t,p],y[Pi*t,p],p},{t,-1,1},{p,-1,1},Axes->False,Boxed->False,PlotPoints->40]
Show[ga,ViewPoint->{1.517, 1.467, 2.645}]
selectgraphics3d[graphics3dobj_,bound_,opts___]:=
Show[Graphics3D[Select[graphics3dobj,
(Abs[#[[1,1,1]]] < bound && Abs[#[[1,1,2]]] < bound &&
Abs[#[[1,1,3]]] < bound && Abs[#[[1,2,1]]] < bound &&
Abs[#[[1,2,2]]] < bound && Abs[#[[1,2,3]]] < bound &&
Abs[#[[1,3,1]]] < bound && Abs[#[[1,3,2]]] < bound &&
Abs[#[[1,3,3]]] < bound && Abs[#[[1,4,1]]] < bound &&
Abs[#[[1,4,2]]] < bound && Abs[#[[1,4,2]]] < bound
)&]],opts]
dip[ins_][g_]:=$DisplayFunction[Insert[g,ins,{1,1}]]
selectgraphics3d[ga[[1]],8,Boxed->False,PlotRange->All,DisplayFunction->dip[EdgeForm[]]]
Respectfully, Roger L. Bagula
tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
alternative email: rlbtftn at netscape.net
URL : http://home.earthlink.net/~tftn