Rhombic Hexecontahedron

Author

Eric W. Weisstein
May 15, 2021

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

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

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

Solid

PolyhedronData["RhombicHexecontahedron","Orientations"]

PolyhedronData["RhombicHexecontahedron"]

Entity

Entity["Polyhedron","RhombicHexecontahedron"]["Graphics3D"]

V5

Show[Graphics3D[poly=Polyhedron[RhombicHexecontahedron]],Boxed->False]

Show[GraphicsArray[{
Graphics3D[{Polyhedron[RhombicTriacontahedron],poly/.Polygon[x_]:>ClosedLine[x]},Boxed->False],
Graphics3D[poly,Boxed->False]
}],GraphicsSpacing->-.2]

182-dodecahedron cluster

Ed Pegg, Jr.
Dec 17, 2018

A spikey made from 182 dodecahedra.

See
http://bridgesmathart.org/2011/cdrom/proceedings/136/paper_136.pdf

icosahedralgroup=Normal[];
dodecrhomb=Normal[];
ff={{1,3,17,16,19},{1,7,10,5,3},{1,19,12,14,7},{2,4,6,9,8},{2,8,14,12,20},{2,20,15,18,4},{3,5,13,11,17},{4,18,11,13,6},{5,10,9,6,13},{7,14,8,9,10},{11,18,15,16,17},{12,19,16,15,20}};

Graphics3D[dodecs=Table[{Polygon[N[dodecrhomb[[n]][[#]].icosahedralgroup[[k]]]]&/@ff},{n,8},{k,60}], Boxed-> False, ViewAngle-> Pi/10, SphericalRegion-> True]

Graphics3D[{{Opacity[.8],dodecs},Thickness[.02],PolyhedronData["RhombicHexecontahedron","Lines"]/.Line[x_]:>Rotate[Line[25x],π/10,{0,0,1}]}]

Net

PolyhedronData

PolyhedronData["RhombicHexecontahedron","Net"]

PolyhedronData["RhombicHexecontahedron","Net","Colored"]

From Stephen (source unknown?)

Properties

<<MathWorld`PolyhedronOperations`

p=PolyhedronData[pname="RhombicHexecontahedron","Polyhedron"]

Centroid

Graphics3D[{AbsolutePointSize[10],
Point[{0,0,0}],{Blue,Point[PolyhedronData[pname,"Centroid"]]},Opacity[.2],PolyhedronData[pname,"GraphicsComplex"]}]

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p]//FullSimplify

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Convex

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

DihedralAngles[p]//FullSimplify//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//Quiet

Faces

FullSimplify[Norm/@Subtract@@@Transpose[Partition[Polyhedron[RhombicHexecontahedron][[1,1]],2]]]

FullSimplify[Divide@@%]

FunctionExpand[GoldenRatio]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

((MomentOfInertia[p,{0,0,0}])/(Volume[p]))//RootReduce//Timing

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

MeanCylindricalRadius

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSquareCylindricalRadius

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify)//Timing

N[i]

MeanSphericalRadius

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSquareSphericalRadius

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify)//Timing

N[i]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//RootReduce//Timing

Total[Area/@PolyhedronData[pname,"Polygons"]]//RootReduce//Timing

VertexSubsetHulls

PolyhedronData["RhombicHexecontahedron","VertexSubsetHulls"]

Icosahedron

v1=Position[v,_?(N[Norm[#]]==s[[1]]&),1]//Flatten

Graphics3D[{PolyhedronData["RhombicHexecontahedron","Faces"],PointSize[.05],Point[v[[v1]]]},Boxed->False]

Graphics3D[ch1=ConvexHull3D[v[[v1]]],Boxed->False]

PolyhedronEdgeLengths[ch1]//FullSimplify

g1=Show[Graphics3D[{{Blue,ConvexHull3D[v[[v1]]]},Green,Opacity[.1],PolyhedronData["RhombicHexecontahedron","Faces"]},Boxed->False],PlotLabel->r==s[[1]]]

Icosidodecahedron

v2=Position[v,_?(N[Norm[#]]==s[[2]]&),1]//Flatten

Graphics3D[{PolyhedronData["RhombicHexecontahedron","Faces"],PointSize[.05],Point[v[[v2]]]},Boxed->False]

Graphics3D[ch2=ConvexHull3D[v[[v2]]],Boxed->False]

PolyhedronEdgeLengths[ch2]//FullSimplify

g2=Show[Graphics3D[{{Blue,ConvexHull3D[v[[v2]]]},Green,Opacity[.3],PolyhedronData["RhombicHexecontahedron","Faces"]},Boxed->False],PlotLabel->r==s[[2]]]

Dodecahedron

v3=Position[v,_?(N[Norm[#]]==s[[3]]&),1]//Flatten

Graphics3D[{PolyhedronData["RhombicHexecontahedron","Faces"],PointSize[.05],Point[v[[v3]]]},Boxed->False]

Graphics3D[ch3=ConvexHull3D[v[[v3]]],Boxed->False]

PolyhedronEdgeLengths[ch3]//FullSimplify

g3=Show[Graphics3D[{{Blue,Opacity[.3],ConvexHull3D[v[[v3]]]},Green,PolyhedronData["RhombicHexecontahedron","Faces"]},Boxed->False],PlotLabel->r==s[[3]]]

Platonic

(h=VertexSubsetHulls[p,"Platonic","Skip"->{"Icosahedron"}])//Timing

h2=SortBy[AppendTo[h,"Icosahedron"->{{14,18,20,26,28,31,32,35,37,43,45,49}}],Length[#[[2,1]]]&]

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[Thickness[.001]],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h2[[All,2]]

Cube

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p,Method->"GaussLaw"]//FullSimplify

Perspective projections

Manipulate[PolyhedronProjectionGraph[PolyhedronData["Cuboctahedron","Polyhedron"],{a,b,c}],{a,-1,1},{b,-1,1},{c,-1,1}]

XXX

PolyhedronProjectionGraph[PolyhedronData["DuererSolid","Polyhedron"],]

Net construction

Pegg Dec 13, 2018

Ed Pegg, Jr.
Dec 13, 2018

"I made a new one in Mathematica, and the code in it allows for easier modifications in terms of moving polygons around. I need to use this code along with random tree subgraphs of the RH graph in a way that detects overlap.  I'm sure there are tighter, prettier nets. "

pol=Normal[];

Graphics[{EdgeForm[Black],Yellow,MapIndexed[{Polygon[#1], Black,Text[#2[[1]],Mean[#1]]}&,pol]}, ImageSize-> Large]

$$SameTest=Dimensions[#1]===Dimensions[#2]&&Max[Chop[#1-#2,1.*^-8]]==0&;

MirrorReflection[(mirror_)?MatrixQ,(pts_)?MatrixQ]:=Block[{p,n,reg,nearest},p=First[mirror];n=Cross@@Transpose[Transpose[Rest[mirror]]-p];reg=Hyperplane[n,p];nearest=RegionNearest[reg,pts];2*nearest-pts]

labelPolygon[pts_,k_]:= Module[{emid,cent},
emid=Mean[#]&/@Partition[pts,2,1,1];
cent=Mean[pts];
{Polygon[pts], Black,Table[Text[n,Mean[{emid[[n]],cent}]],{n,1,Length[emid]}],Blue, Text[k,cent ]}];

reflectPolygon[pts_,edgenum_]:= Module[{edges},
edges=Partition[pts,2,1,1];MirrorReflection[edges[[edgenum]],pts]];

Graphics[{EdgeForm[Black],Yellow,MapIndexed[labelPolygon[#1,#2[[1]]]&,pol]}, ImageSize-> Large]

Pegg Dec 19, 2018

Spikey with Labeled Net (Ed Pegg Jr)

There are 20 horizontal rhombs.
The corner on the right always has valence 3.
The corner on the left always has valence 5.

A wooden hinged version of this with magnets embedded for valence 3 should work nicely.  Lifting one V3 corner should cause the whole thing to self-assemble.

Here is a labeled Spikey.

rh=Normal[]; face=Normal[];Graphics3D[{EdgeForm[{GrayLevel[0,.2],Thick}],Opacity[.9],Table[{Polygon[rh[[face[[n]]]]], Black,Opacity[1], Style[Text[n, Mean[rh[[face[[n]]]]]],16]},{n,1,60}]
}/.ϕ->GoldenRatio, Boxed-> False ,ImageSize-> Medium, ViewAngle-> Pi/10]

And a labeled net for it.

rr=Normal[];
Graphics[{EdgeForm[Black],LightYellow,Polygon[#]&/@rr,Black, MapIndexed[Text[#2[[1]],Mean[#1]]&,rr],
Black, Thickness[.007], polyLine[rr[[#[[1]]]],#[[2]]]&/@{{2,4},{3,4},{4,4},{5,4},{56,3},{57,3},{58,3},{59,3}}
}, ImageSize-> Large]

Pegg Dec 20, 2018

Spikey with Labeled Net (Ed Pegg Jr)

There are 20 horizontal rhombs.
The corner on the right always has valence 3.
The corner on the left always has valence 5.

A wooden hinged version of this with magnets embedded for valence 3 should work nicely.  Lifting one V3 corner should cause the whole thing to self-assemble.

Setup values.

rh=Normal[]; face=Normal[];rr=Normal[];
cuts={{2,3},{3,3},{4,3},{5,3},{56,2},{57,2},{58,2},{59,2}};
polyLine[poly_,edgenum_]:= Line[Partition[poly,2,1,1][[edgenum]]];
colors=Flatten[Map[Table[Lighter[#[[2]]],{#[[1]]}]&,Transpose[{{5,10,5,20,5,10,5},{Cyan,Yellow,Red,Green,Red,Yellow,Cyan}}]]];

Here is a colored spikey.

Graphics3D[{EdgeForm[{GrayLevel[0,.2],Thick}],Opacity[.9],Table[{colors[[n]],Polygon[rh[[face[[n]]]]]},{n,1,60}]}/.ϕ->GoldenRatio, Boxed-> False ,ImageSize-> Medium, ViewAngle-> Pi/10]

And a colored net for it. The dark lines are cuts. Dots mark the outer vertices.

Graphics[{EdgeForm[{GrayLevel[0,.2],Thick}],Table[{colors[[n]],Polygon[rr[[n]]], Black,Point[.9rr[[n,1]]+.1rr[[n,3]]]},{n,1,60}],Black, Thickness[.007], polyLine[rr[[#[[1]]]],#[[2]]]&/@cuts}/.ϕ->GoldenRatio, ImageSize-> Large]

In case numbers are wanted.

Graphics3D[{EdgeForm[{GrayLevel[0,.2],Thick}],Opacity[.9],Table[{colors[[n]],Polygon[rh[[face[[n]]]]], Black,Opacity[1], Style[Text[n, Mean[rh[[face[[n]]]]]],16]},{n,1,60}]}/.ϕ->GoldenRatio, Boxed-> False ,ImageSize-> Medium, ViewAngle-> Pi/10]

Graphics[{EdgeForm[{GrayLevel[0,.2],Thick}],Table[{colors[[n]],Polygon[rr[[n]]], Black,Opacity[1], Style[Text[n, Mean[rr[[n]]]],12]},{n,1,60}],Black, Thickness[.007], polyLine[rr[[#[[1]]]],#[[2]]]&/@cuts}/.ϕ->GoldenRatio, ImageSize-> Large]

PolyhedronData

Exact hand-construction by Eric Weisstein ca. 2009 (?)

faces=;

poly=Polygon/@faces;

Graphics[{EdgeForm[Black],FaceForm[Yellow],poly}]

N[Norm/@(Subtract@@@Flatten[l/.Polygon[x_]:>Partition[x,2,1,1],1]),20]//Union

net=NetFromPolygons[l]

Graphics[{EdgeForm[Black],FaceForm[Yellow],net,Blue,Line[{{0,12},{0,0},{15,0}}]},Frame->True]

Normal[net]

RootReduce[Norm/@(Subtract@@@Flatten[Normal[net][[1]]/.Polygon[x_]:>Partition[x,2,1,1],1])]//Union

Stellation net

Show[Graphics3D[Polyhedron[RhombicTriacontahedron]],Boxed->False]

p=Polyhedron[RhombicTriacontahedron][[1]];

r=If[Greater@@Norm/@Subtract@@@(p[[1]][[#]]&/@{{1,3},{2,4}}),p[[1]],RotateLeft[p[[1]]]];

q=Function[v,Polygon[v+GoldenRatio#&/@{0,v-r[[2]],
2v-r[[2]]-r[[4]],v-r[[4]]}]]/@r[[{1,3}]];

Show[Graphics3D[{{Red,p},{Blue,q}}],Boxed->False,ViewPoint->Plus@@p[[1]]/4+Cross[p[[1,2]]-p[[1,1]],p[[1,3]]-p[[1,1]]],
ViewVertical->{2.66,1,1},Lighting->False
]

poly=Function[p,r=If[Greater@@Norm/@Subtract@@@(p[[1]][[#]]&/@{{1,3},{2,4}}),p[[1]],RotateLeft[p[[1]]]];
q=Function[v,Polygon[v+GoldenRatio#&/@{0,v-r[[2]],
2v-r[[2]]-r[[4]],v-r[[4]]}]]/@r[[{1,3}]]]/@Polyhedron[RhombicTriacontahedron];

Solid

<<Utilities`Simplify`
Off[N::"meprec"];

?Orient

poly2=Orient[Map[ToExact,Flatten[poly],{3}]];
(v=PolyhedronVertices[poly2])//InputForm
First/@poly2/.Thread[v->Range[Length[v]]]

PolyhedronData

Graphics3D[{FaceForm[Blue,Red],Orient@Polyhedron[RhombicHexecontahedron]}]

PolyhedronDataString[Orient@FullSimplify[Polyhedron[RhombicHexecontahedron]],
"StandardName"->"RhombicHexecontahedron",
"Information"->"RhombicHexecontahedron",
"Name"->"rhombic hexecontahedron",
"NotationRules"->{"Stellation"->{"RhombicTriacontahedron",1}},
"Classes"->{"Stellation"},
Debug->True,
TimeConstraint->600
]