Zome

Eric W. Weisstein
January 25, 2002

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

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

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

Initialization

<<LiveGraphics3D`;
<<PolyhedronOperations`;
<<MiscPolyhedra`;

Construction of Analytic Version

This construction by Ed Pegg.

Converted to pure analytic form (removing numerical portions and trig functions) by Eric Weisstein, 01/25/2002.

b1 = 1;
b2 = GoldenRatio ;
b3 = GoldenRatio^2;
y1 = Cos[Pi/6];
y2 = GoldenRatio Cos[Pi/6];
y3 = GoldenRatio^2 Cos[Pi/6];
rr1 = Cos[Pi/10];
rr2 = GoldenRatio Cos[Pi/10];
rr3 = GoldenRatio^2 Cos[Pi/10];
g1 = Sqrt[2]/GoldenRatio;
g2 = Sqrt[2];
g3 = Sqrt[2] GoldenRatio;
loc[a_,b_,c_] := 180 -ArcCos[(c^2 - a^2 - b^2)/(2 a b)]*180/Pi ;
pentang = loc[rr3,b3,y2]*Pi/180;
pentdist = (1/2) /Tan[Pi/10];
triang = loc[b3,y3, rr1]*Pi/180;
tridist = (GoldenRatio/2)/Tan[Pi/6];
rect = {{GoldenRatio/2,1/2,-GoldenRatio^2},{GoldenRatio/2,-1/2,-GoldenRatio^2},{ -GoldenRatio/2,-1/2, -GoldenRatio^2},{ -GoldenRatio/2,1/2,-GoldenRatio^2}};
pent ={{GoldenRatio/2 + Cos[Pi/10] Cos[pentang],-1/2 - Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{(GoldenRatio/2),-(1/2),-(GoldenRatio^2)},{(GoldenRatio/2),+(1/2),-(GoldenRatio^2)},{GoldenRatio/2 + Cos[Pi/10] Cos[pentang],1/2 + Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{GoldenRatio/2 + pentdist Cos[pentang],0,pentdist Sin[pentang]-GoldenRatio^2 }};
pent2 ={{-GoldenRatio/2 - Cos[Pi/10] Cos[pentang],-1/2 - Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{-(GoldenRatio/2),-(1/2),-(GoldenRatio^2)},{-(GoldenRatio/2),+(1/2),-(GoldenRatio^2)},{-GoldenRatio/2 - Cos[Pi/10] Cos[pentang],1/2 + Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{-GoldenRatio/2 - pentdist Cos[pentang],0,pentdist Sin[pentang]-GoldenRatio^2 }};
tri = {{0,1/2 + tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{GoldenRatio/2,1/2,-GoldenRatio^2},{ -GoldenRatio/2,1/2,-GoldenRatio^2}};
tri2 = {{0,-1/2 - tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{GoldenRatio/2,-1/2,-GoldenRatio^2},{ -GoldenRatio/2,-1/2,-GoldenRatio^2}};
tri3a = GoldenRatio/2 + Cos[Pi/10] Cos[pentang];
tri3b = 1/2 + Sin[Pi/10];
tri3c = GoldenRatio^2 - Cos[Pi/10] Sin[pentang];
tri3ppp = {{tri3a,tri3b,tri3c}, {tri3b,tri3c,tri3a},{tri3c,tri3a,tri3b}};
tri3ppm = {{tri3a,tri3b,-1*tri3c}, {tri3b,tri3c,-1*tri3a},{tri3c,tri3a,-1*tri3b}};
tri3pmp = {{tri3a,-1*tri3b,tri3c}, {tri3b,-1*tri3c,tri3a},{tri3c,-1*tri3a,tri3b}};
tri3mpp = {{-1*tri3a,tri3b,tri3c}, {-1*tri3b,tri3c,tri3a},{-1*tri3c,tri3a,tri3b}};
tri3pmm = {{tri3a,-1*tri3b,-1*tri3c}, {tri3b,-1*tri3c,-1*tri3a},{tri3c,-1*tri3a,-1*tri3b}};
tri3mmp = {{-1*tri3a,-1*tri3b,tri3c}, {-1*tri3b,-1*tri3c,tri3a},{-1*tri3c,-1*tri3a,tri3b}};
tri3mpm = {{-1*tri3a,tri3b,-1*tri3c}, {-1*tri3b,tri3c,-1*tri3a},{-1*tri3c,tri3a,-1*tri3b}};
tri3mmm = {{-1*tri3a,-1*tri3b,-1*tri3c}, {-1*tri3b,-1*tri3c,-1*tri3a},{-1*tri3c,-1*tri3a,-1*tri3b}};
rectpp = {{0,1/2 + tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{GoldenRatio/2,1/2,-GoldenRatio^2},{GoldenRatio/2 + Cos[Pi/10] Cos[pentang],1/2 + Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{(1+Sqrt[5])/4,(2+Sqrt[5])/2,-GoldenRatio} };
rectpm = {{0,-1/2 - tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{GoldenRatio/2,-1/2,-GoldenRatio^2},{GoldenRatio/2 + Cos[Pi/10] Cos[pentang],-1/2 - Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{(1+Sqrt[5])/4,-(2+Sqrt[5])/2,-GoldenRatio} };
rectmp = {{0,1/2 + tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{-GoldenRatio/2,1/2,-GoldenRatio^2},{-GoldenRatio/2 - Cos[Pi/10] Cos[pentang],1/2 + Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{-(1+Sqrt[5])/4,(2+Sqrt[5])/2,-GoldenRatio} };
rectmm = {{0,-1/2 - tridist Cos[triang],tridist Sin[triang]-GoldenRatio^2},{-GoldenRatio/2,-1/2,-GoldenRatio^2},{-GoldenRatio/2 - Cos[Pi/10] Cos[pentang],-1/2 - Sin[Pi/10],-GoldenRatio^2 + Cos[Pi/10] Sin[pentang]},{-(1+Sqrt[5])/4,-(2+Sqrt[5])/2,-GoldenRatio} };
r1 = {{0,0,1},{1,0,0},{0,1,0}};
r2 = {{0,1,0},{0,0,1},{1,0,0}};

Zome={Polygon[rect],Polygon[tri],Polygon[pent],Polygon[pent2], Polygon[tri2], Polygon[rectpp],Polygon[rectpm],Polygon[rectmp],Polygon[rectmm],Polygon[rect*-1],Polygon[tri*-1],Polygon[pent*-1],Polygon[pent2*-1], Polygon[tri2*-1], Polygon[rectpp*-1],Polygon[rectpm*-1],Polygon[rectmp*-1],Polygon[rectmm* -1],

Polygon[rect.r1],Polygon[tri.r1],Polygon[pent.r1],Polygon[pent2.r1], Polygon[tri2.r1], Polygon[rectpp.r1],Polygon[rectpm.r1],Polygon[rectmp.r1],Polygon[rectmm.r1],Polygon[(rect*-1).r1],Polygon[(tri*-1).r1],Polygon[(pent*-1).r1],Polygon[(pent2*-1).r1], Polygon[(tri2*-1).r1], Polygon[(rectpp*-1).r1],Polygon[(rectpm*-1).r1],Polygon[(rectmp*-1).r1],Polygon[(rectmm* -1).r1],

Polygon[rect.r2],Polygon[tri.r2],Polygon[pent.r2],Polygon[pent2.r2], Polygon[tri2.r2], Polygon[rectpp.r2],Polygon[rectpm.r2],Polygon[rectmp.r2],Polygon[rectmm.r2],Polygon[(rect*-1).r2],Polygon[(tri*-1).r2],Polygon[(pent*-1).r2],Polygon[(pent2*-1).r2], Polygon[(tri2*-1).r2], Polygon[(rectpp*-1).r2],Polygon[(rectpm*-1).r2],Polygon[(rectmp*-1).r2],Polygon[(rectmm* -1).r2],

Polygon[tri3ppp], Polygon[tri3ppm],Polygon[tri3pmp],Polygon[tri3mpp],Polygon[tri3pmm],Polygon[tri3mmp],Polygon[tri3mpm],Polygon[tri3mmm] };

FullSimplify[FunctionExpand[Simplify[Zome]]]

Check Edge Lengths of Solid

Simplify[PolyhedronEdgeLengths[Zome]]

Solid Properties

Circumradius

Union[Simplify[Sqrt[#.#]&/@PolyhedronVertices[Zome]]]

Volume

FullSimplify[PolyhedronSymmetricVolume[Zome]]

Surface Area

FullSimplify[PolyhedronSymmetricSurfaceArea[Zome]]

RootReduce[%]

Graphics

Show[Graphics3D[Zome],Boxed->False]

WriteLiveForm["zome.m",Show[Graphics3D[Zome,Boxed->False]]]

Show[Graphics3D[Bevel[Zome,.2]],Boxed->False]

Show[Graphics3D[Flatten[Bevel[Zome,.2,.7]]],Boxed->False]

WriteLiveForm["zomefram.m",Show[Graphics3D[Flatten[Bevel[Zome,.2,.7]]],Boxed->False]]

Rectangles only

N[{GoldenRatio^2,GoldenRatio^3,GoldenRatio^4,GoldenRatio^5}]

Show[Graphics3D[{EdgeForm[],Polygon[rect],  Polygon[rectpp],Polygon[rectpm],Polygon[rectmp],Polygon[rectmm],Polygon[rect*-1], Polygon[rectpp*-1],Polygon[rectpm*-1],Polygon[rectmp*-1],Polygon[rectmm* -1],Polygon[rect.r1], Polygon[rectpp.r1],Polygon[rectpm.r1],Polygon[rectmp.r1],Polygon[rectmm.r1],Polygon[(rect*-1).r1], Polygon[(rectpp*-1).r1],Polygon[(rectpm*-1).r1],Polygon[(rectmp*-1).r1],Polygon[(rectmm* -1).r1],Polygon[rect.r2], Polygon[rectpp.r2],Polygon[rectpm.r2],Polygon[rectmp.r2],Polygon[rectmm.r2],Polygon[(rect*-1).r2], Polygon[(rectpp*-1).r2],Polygon[(rectpm*-1).r2],Polygon[(rectmp*-1).r2],Polygon[(rectmm* -1).r2] }],Boxed->False]