Polar Zonohedron

Author

Eric W. Weisstein
December 7, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/PolarZonohedron.nb.

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

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

Code

PolarZonohedron[n_]:=Module[{e,diags},
e=KSubsets[PolyhedronVertices[If[EvenQ[n],Prism[n],Polyhedron[Antiprism[n]]]],2];
norm=Norm/@e;
diags=Select[e,Simplify[Norm[#]-Max[norm]]==0&];
Zonohedron[Subtract@@@diags]
]

Graphics

Off[N::"meprec"]

Show[GraphicsArray[Graphics3D[#,Boxed->False]&/@PolarZonohedron/@Range[3,6]
],GraphicsSpacing->-.1]

Examples from Towle

This code should be rewritten

vectors[n_Integer,pitch_,fac_Integer,ratio_]:=Block[{e},Table[If[Mod[i,fac]==0,e=ratio,e=1];
N[{e Cos[Degree pitch] Cos[2Pi i/n],e Cos[Degree pitch] Sin[2Pi i/n],-e Sin[Degree pitch]}],{i,0,n-1}]]

quad[x_,ref_]:={ref,ref+x[[1]],ref+x[[1]]+x[[2]],mark=ref+x[[2]]}

PolarZonohedron[n_Integer,pitch_,fac_Integer,ratio_]:=Block[{v,h},v=vectors[n,pitch,fac,ratio];
h=(Plus@@v)/2;
Graphics3D[Polygon/@Flatten[Table[mark=-h;
Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,n-1}],{j,n}],1]]]

Show[PolarZonohedron[12,35.2643,3,3],Boxed->False,ViewPoint->{1,1,3}]

Show[PolarZonohedron[12,35.2643,2,2],Boxed->False,ViewPoint->{1,1,3}]

Show[PolarZonohedron[12,35.2643,12,5],Boxed->False,ViewPoint->{1,1,3}]

Towle Dodecahedron Vertices

Show[Graphics3D[Zonohedron[PolyhedronVertices[Dodecahedron]]]]