Cone Net

Author

Eric W. Weisstein
February 10, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SolidGeometry/ConeNet.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/ConeNet.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Code

ConeGrids[a_,d_,oo_:{0,0}]:=Module[{o={oo,oo}},Which[a==90Degree,{Line/@Table[o+{{i,0},{i,Sqrt[1-i^2]}},{i,0,1,d}],Line/@Table[o+{{i Cot[a],i},{Sqrt[1-i^2],i}},{i,0,Sin[a],d}]},a<90 Degree,{Line/@Table[o+{{i,0},{i,Min[i Tan[a],Sqrt[1-i^2]]}},{i,0,1,d}],Line/@Table[o+{{i Cot[a],i},{Sqrt[1-i^2],i}},{i,0,Sin[a],d}]},a==180Degree,{Line/@Table[o+{{i,0},{i,Sqrt[1-i^2]}},{i,0,-1,-d}],Line/@Table[o+{{i,0},{i,Sqrt[1-i^2]}},{i,d,1,d}],Line/@Table[o+{{-Sqrt[1-i^2],i},{Sqrt[1-i^2],i}},{i,0,1,d}]},a<180Degree,{Line/@Table[o+{{i,Max[i Tan[a],0]},{i,Sqrt[1-i^2]}},{i,Cos[a],1,d}],Line/@Table[o+{{Max[i Cot[a],-Sqrt[1-i^2]],i},{Sqrt[1-i^2],i}},{i,0,1,d}]},a<270Degree,{Line/@Table[o+{{i,Min[0,Max[i Tan[a],-Sqrt[1-i^2]]]},{i,Sqrt[1-i^2]}},{i,-1,1,d}],Line/@Table[o+{{Max[i Cot[a],-Sqrt[1-i^2]],i},{-Sqrt[1-i^2],i}},{i,Sin[a],0,d}],Line/@Table[o+{{-Sqrt[1-i^2],i},{Sqrt[1-i^2],i}},{i,0,1,d}]},a==270Degree,{Line/@Table[o+{{i,0},{i,Sqrt[1-i^2]}},{i,-1,1,d}],Line/@Table[o+{{i,0},{i,-Sqrt[1-i^2]}},{i,-d,-1,-d}],Line/@Table[o+{{0,i},{-Sqrt[1-i^2],i}},{i,Sin[a],0,d}],Line/@Table[o+{{-Sqrt[1-i^2],i},{Sqrt[1-i^2],i}},{i,0,1,d}]}]]

ConeGrid[a_,d_,o_:{0,0}]:=Module[{i},Graphics[{ConeGrids[a,d,o],Circle[o,1,{0,a}],{Thickness[.01],Line[{o+{1,0},o+{0,0},o+{Cos[a],Sin[a]}}]}}]]

xform[{x_,y_},n_]:=Module[{h=Sqrt[1-n^2],t=If[x==0&&y==0,0,ArcTan[x,y]],r=Sqrt[x^2+y^2]},{r n Cos[t/n],r n Sin[t/n],(1-r)h}]

conelines[n_/;n==1/4,dr_,dx_]:=Module[{i,j},{Line/@Table[xform[{j,i},n],{j,0,1,dr},{i,0,Sqrt[1-j^2],dx}],Line/@Table[xform[{i,j},n],{j,0,1,dr},{i,0,Sqrt[1-j^2],dx}]}]

conelines[n_/;n==1/2,dr_,dx_]:=Module[{i,j},{Line/@Table[xform[{j,i},n],{j,0,1,dr},{i,-Sqrt[1-j^2],Sqrt[1-j^2],dx}],Line/@Table[xform[{i,j},n],{j,0,1,dr},{i,-Sqrt[1-j^2],Sqrt[1-j^2],dx}]}]

conelines[n_/;n==3/4,dr_,dx_]:=Module[{i,j},{Line/@Table[xform[{j,i},n],{j,0,1,dr},{i,-Sqrt[1-j^2],Sqrt[1-j^2],dx}],Line/@Table[xform[{i,j},n],{j,-1,1,dr},{i,-Sqrt[1-j^2],Sqrt[1-j^2],dx}]}]

ConeNet[n_,dx_:.05,dr_:.005,sides_:30]:=Module[{i},{conelines[n,dx,dr],Line[Table[n{Cos[2Pi i/sides],Sin[2Pi i/sides],0},{i,0,sides}]]}]

ConeNetFilled[n_,dx_:.05,dr_:.005,sides_:30]:=Module[{i,j},{{EdgeForm[],FaceForm[GrayLevel[1],GrayLevel[1]],cone[sides,n,Sqrt[1-n^2],0,1,Caps->False][[1]]},{FaceForm[GrayLevel[1],GrayLevel[1]],Polygon[Table[n{Sin[2Pi i/sides],Cos[2Pi i/sides],0},{i,sides}]]},conelines[n,dx,dr]}]

ConeGrid::usage="ConeGrid[a,d,o] gives a grid with spacing d and origin o having opening angle a used to form a cone net."

ConeNet::usage="ConeNet[n,dx,dr,sides] gives a 3-D net of spacing dx mapped onto a cone formed from a segment comprising a fraction n (where n=1/4, 1/2, and 3/4) of a circle, and with step size dr."

ConeNetFilled::usage="ConeNetFilled[n,dx,dr,sides] gives a 3-D net of spacing dx mapped onto a cone formed from a segment comprising a fraction n (where n=1/4, 1/2, and 3/4) of a circle, and with step size dr.  Filled refers to the fact that a solid cone is placed in the interior so as to hide lines in back."

Graphics

Planar

Show[Table[ConeGrid[90n Degree,1/10,{2.5n,0}],{n,3}],AspectRatio->Automatic]

3-D

With[{grid=.1,dr=.01},
Show[GraphicsArray[
Transpose[Table[{
Graphics3D[ConeNetFilled[n/4,grid,dr,30],Lighting->False,Boxed->False],
Graphics3D[ConeNet[n/4,grid,dr,30],ViewPoint->{0,0,10},ViewVertical->{-1,1,0},Boxed->False]
},{n,3}]]
],GraphicsSpacing->{-.05,-.25}]
]

Show[Graphics3D[ConeNet[1/4,.05,.005,30]],ViewPoint->{0,0,10},ViewVertical->{-1,1,0},Boxed->False]

Show[Graphics3D[ConeNet[1/2,.05,.005,30]],ViewPoint->{0,0,10},ViewVertical->{-1,1,0},Boxed->False]

Show[Graphics3D[ConeNet[3/4,.05,.01,30]],ViewPoint->{0,0,10},ViewVertical->{-1,1,0},Boxed->False]