Great Rhombic Triacontahedron

Author

Eric W. Weisstein
September 10, 2023

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

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

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

Polyhedron

PolyhedronData["GreatRhombicTriacontahedron","Orientations"]

PolyhedronData["GreatRhombicTriacontahedron"]

Show[PolyhedronData[{"GreatRhombicTriacontahedron",#}],Boxed->False]&/@PolyhedronData["GreatRhombicTriacontahedron","Orientations"]

Polyhedron

Graphics3D[{FaceForm[Green,Red],PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"]}]

Region

PolyhedronData["GreatRhombicTriacontahedron","Region"]

Solid and Dual

Show[PolyhedronData["GreatRhombicTriacontahedron",#],Boxed->False]&/@{"Graphics3D","Dual","DualCompound"}

Properties: "GreatRhombicTriacontahedron"

Initialization

<<MathWorld`Polyhedra`

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

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

convexhullname=PolyhedronData[pname,"ConvexHull","Name"]

PolyhedronData[pname,"ConvexHull","Scale"]

PolyhedronData[pname,"ConvexHull","RotationMatrix"]

Graphics3D[convexhull=PolyhedronData[pname,"ConvexHull","Polyhedron"]]

{
Graphics3D[{Red,Opacity[.5],p}],
Graphics3D[{Blue,Opacity[.5],convexhull}]
}

Show[%]

Construct using ConvexHullRegion

Graphics3D[convexhull=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhull]

Sort[(convexhull[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally//FullSimplify

((Max[Norm/@p[[1]]])/(Max[Norm/@PolyhedronData[convexhullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

N[{(2/(Sqrt[5+2 (Sqrt[5])])),(Sqrt[4-(8/(Sqrt[5]))])}]

Find rotation matrix

Graphics3D[{FaceForm[Green,Red],basesolid=PolyhedronData[convexhullname,"Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,basev=basesolid[[1]]]}]

RotationMatrix[{Mean[basev[[{11,12}]]],{0,0,1}}]//FullSimplify

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

(dehn=DehnInvariant[p,Debug->True])//Timing

ToConwayBasis[dehn]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p]]//Tally

Dual

pname

dname=PolyhedronData[pname,"Dual","Name"]

PolyhedronData[pname,"Dual","Scale"]

midrs={PolyhedronData[pname,"Midradius"],PolyhedronData[dname,"Midradius"]}

Divide@@midrs//FullSimplify

GraphicsRow[With[{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
style=Directive[Black,Italic,FontFamily->"Times",14]
},
{
Graphics3D[{s,Green ,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},Boxed->False,PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center]],
Graphics3D[{s,Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},Boxed->False,PlotLabel->Style[PolyhedronData[dname,"Name"],style]],
Graphics3D[{
{Green,Opacity[.5],PolyhedronData[pname,"Polyhedron"]},
{Red,Opacity[.5],PolyhedronData[pname,"Dual","Polyhedron"]},
s
},Boxed->False,PlotLabel->Style["compound with midsphere",style]],
Graphics3D[{
PolyhedronData[pname,"Polyhedron"],
PolyhedronData[pname,"Dual","Polyhedron"]
},Boxed->False,PlotLabel->Style["compound",style]]
}],Alignment->Top,ImageSize->800]

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

Tally[PolyhedronEdgeLengths[p]//RootReduce]

PolyhedronData[pname,"EdgeLengths"]

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

lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]];//Quiet

(distinctlens=Mean/@Split[Sort[lens],Abs[#1-#2]<1.*^-10&])//N//Quiet

v=p[[1]];

colors=With[{n=Length[distinctlens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[distinctlens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[p],Boxed->False]//Quiet

FaceCount

PolyhedronData[pname,"FaceCount"]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

hullname=PolyhedronData[pname,"Hull","Name"]

PolyhedronData[pname,"Hull","Scale"]

((Max[Norm/@PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"][[1]]])/(Max[Norm/@PolyhedronData["GreatRhombicTriacontahedronHull","Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Graphics3D[{
Opacity[.2],
Green,PolyhedronData["GreatRhombicTriacontahedron","Hull","Polyhedron"],
Blue,PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"]}]

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===hullname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.2],p},Red,sphere},Boxed->False]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p//N,Debug->False])//Timing

RootApproximant[0.552786404500042`]//FullSimplify

(sphere=Midsphere[p,Method->"PointLineDistance"])//Timing

Graphics3D[{{Opacity[.5],Yellow,p},{Red,sphere}},Boxed->False]

Net

PolyhedronData[pname,"Net"]

NotationRules

PolyhedronData[pname,"NotationRules"]

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

Show[PolyhedronData[{pname,#}],Boxed->False]&/@PolyhedronData[pname,"Orientations"]

Polygons

PolyhedronData[pname,"FaceCount"]

PolyhedronFaceTally[p]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

PolyhedronData[pname,"Skeleton"]

gn=PolyhedronData[pname,"Skeleton","Name"]

emb=GraphData[gn,"PolyhedralEmbeddings"]

GraphData[gn,"Graph",{"3D","All"}]

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

Total[Area/@PolyhedronData[pname,"Polygons"]]//ToAlgebraicRoot

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

With[{rules=PolyhedronData[pname,"NotationRules"]},{
UniformPolyhedron[Lookup[rules,"WenningerIndex"]],
UniformPolyhedron[{"Coxeter",Lookup[rules,"CoxeterIndex"]}],
UniformPolyhedron[{"Kaleido",Lookup[rules,"KaleidoIndex"]}],
UniformPolyhedron[{"Uniform",Lookup[rules,"MaederIndex"]}],
UniformPolyhedron[{"Wenninger",Lookup[rules,"WenningerIndex"]}]
}]

Equal@@%

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Length[#2]]&@@@subsethulls

Rule[#,Graphics3D[Function[f,ConvexHullRegion[v[[f]]]]/@#2]]&@@@subsethulls

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

Rule[#,Graphics3D[{{Opacity[.3],{Green,p}},Blue,ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Convex hull

Graphics3D[convexhullreg=ConvexHullRegion[v=PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

Flatten[(convexhullreg[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]//Union

%===Range@Length@v

PolyhedronData[pname,"ConvexHull","Name"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]

PolyhedronVolume[p]

Volume[PolyhedronData[pname,"Region"]]

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: "GreatRhombicTriacontahedronHull"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

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

(xbar=RegionCentroid[p]//RootReduce)//Quiet

PolyhedronCentroid[p]//RootReduce//Quiet

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p]]//Tally

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

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

FaceCount

PolyhedronData[pname,"FaceCount"]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

HullOf

Select[PolyhedronData[All],PolyhedronData[#,"HullName"]===pname&]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

PolyhedronInertiaTensor[p]//RootReduce//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.5],p},{Red,sphere}},Boxed->False]

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)//Quiet//Timing

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

N[i]

MeanSquareCylindricalRadius

PolyhedronData[pname,"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"])))//Timing

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]//Quiet

MeanSphericalRadius

PolyhedronData[pname,"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

PolyhedronData[pname,"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"])))//Timing

N[i]

r=RootApproximant[N[i,1000],32]//FullSimplify

N[i-r,10^4]//Quiet

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

Orientations

PolyhedronData[pname,"Orientations"]

PolyhedronData[pname,"DefaultOrientation"]

Show[PolyhedronData[{pname,#}]]&/@PolyhedronData[pname,"Orientations"]

Region

PolyhedronData[pname,"Region"]

SimplePolyhedron

SimplePolyhedronQ[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//ToAlgebraicRoot//Timing

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

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify//Timing

PolyhedronVolume[p]//FullSimplify//Timing

Perspective projections

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

XXX

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

Construction

Uniform

<<MathWorld`Polyhedra`

BulatovUniformDualName[bulatovindex=59]

BulatovUniformDualGraphics3D[bulatovindex]

bulatov=BulatovUniformDualPolyhedron[bulatovindex]

v=((bulatov[[1]])/(Mean[PolyhedronEdgeLengths[bulatov]]))

vexact=Map[RootApproximant,Chop[v],{2}]//FullSimplify

p=Polyhedron[vexact,bulatov[[2]]]

PolyhedronEdgeLengths[p]//RootReduce//Union

Hull

Show[Graphics3D[ExpandPolygons[Polyhedron[RhombicTriacontahedron],1+2GoldenRatio]],Boxed->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];

Need to calculate caps that go in each dimple

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}]];

<<Graphics`Colors`

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
]

<<PlaneGeometry`

x[1]={(5+Sqrt[5])/8,0};
x[2]={0,Sqrt[5]/4};
x[3]=GoldenRatio^3x[1];
x[4]=GoldenRatio^3x[2];
Show[Graphics[{
ClosedLine[{x[1],x[2],-x[1],-x[2]}],
ClosedLine[{x[3],x[4],-x[3],-x[4]}]
},AspectRatio->Automatic]]

x[5]

x[6]

x[7]

x[8]=Coordinates[FullSimplify[Intersections[Line[x/@{1,5}],Line[{x[6],{1,-1}x[6]}]]]]

x[9]=Coordinates[FullSimplify[Intersections[Line[{{-1,1}x[8],x[7]}],Line[x/@{3,4}]]]]

x[10]=Coordinates[FullSimplify[Intersections[Line[{{0,0},{1,0}}],Line[{x[8],{-1,1}x[9]}]]]]

x[11]=Coordinates[FullSimplify[Intersections[Line[x/@{8,10}],Line[{x[3],{1,-1}x[4]}]]]]

Show[Graphics[{
{Yellow,Polygon[{x[1],x[2],-x[1],-x[2]}]},
{GrayLevel[.7],Table[Polygon[{i x[4],i{j,1}x[9],i{j,1}x[7]}],{i,-1,1,2},{j,-1,1,2}],
Table[Polygon[{(-1)^i,1}#&/@{x[3],x[5],x[8],x[10],{1,-1}x[8],{1,-1}x[5]}],{i,2}]
},
ClosedLine[{x[3],x[4],-x[3],-x[4]}],
ClosedLine[{x[6],{-1,1}x[6],-x[6],{1,-1}x[6]}],
Table[Line[(-1)^i{{1,-1(-1)^j}x[6],{1,(-1)^j}x[4]}],{i,2},{j,2}],
Table[Line[(-1)^i{{(-1)^j,1}x[6],-{(-1)^j,1} x[5]}],{i,2},{j,2}],
Table[Line[(-1)^j{{-1(-1)^i,1}x[9],{(-1)^i,1}x[11]}],{i,2},{j,2}],
PointSize[.02],Table[{Text[i,x[i]+.2],{Red,Point[x[i]]}},{i,11}]
},AspectRatio->Automatic]]

Show[Graphics[{
{Yellow,Polygon[{x[1],x[2],-x[1],-x[2]}]},
{GrayLevel[.7],Table[Polygon[{i x[4],i{j,1}x[9],i{j,1}x[7]}],{i,-1,1,2},{j,-1,1,2}],
Table[Polygon[{(-1)^i,1}#&/@{x[3],x[5],x[8],x[10],{1,-1}x[8],{1,-1}x[5]}],{i,2}]
},
ClosedLine[{x[3],x[4],-x[3],-x[4]}],
ClosedLine[{x[6],{-1,1}x[6],-x[6],{1,-1}x[6]}],
Table[Line[(-1)^i{{1,-1(-1)^j}x[6],{1,(-1)^j}x[4]}],{i,2},{j,2}],
Table[Line[(-1)^i{{(-1)^j,1}x[6],-{(-1)^j,1} x[5]}],{i,2},{j,2}],
Table[Line[(-1)^j{{-1(-1)^i,1}x[9],{(-1)^i,1}x[11]}],{i,2},{j,2}]
},AspectRatio->Automatic]]

Show[Graphics[{
{Yellow,Polygon[{{x1,0},{0,y1},{-x1,0},{0,-y1}}]},
GrayLevel[.7],
Table[Polygon[{i x[4],i{j,1}x[9],i{j,1}x[7]}],{i,-1,1,2},{j,-1,1,2}],
Table[Polygon[{(-1)^i,1}#&/@{x[3],x[5],x[8],x[10],{1,-1}x[8],{1,-1}x[5]}],{i,2}]
}],AspectRatio->Automatic]

Now map this onto the rhombic triacontahedron

FullSimplify[FunctionExpand[x/@{3,4,5,7,8,9,10}]]//InputForm

StellationPattern[l_]:=Module[{x3,x5,x7,x8,x9,x10,r,c,xhat,yhat,i,j},
r=If[Greater@@Norm/@Subtract@@@(l[[#]]&/@{{1,3},{2,4}}),l,RotateLeft[l]];
c=Mean[l];
xhat=#/Norm[#]&[r[[1]]-c];
yhat=#/Norm[#]&[r[[2]]-c];
{x3,x4,x5,x7,x8,x9,x10}={{(15+7*Sqrt[5])/8,0},{0,(5+2*Sqrt[5])/4},{(5+2*Sqrt[5])/4,(5+Sqrt[5])/8},{(5-Sqrt[5])/8,(5+3*Sqrt[5])/8},{(-2+6/Sqrt[5])^(-1),(2+2/Sqrt[5])^(-1)},{(5+Sqrt[5])/8,(5+Sqrt[5])/4},{(5*(1+Sqrt[5]))/8,0}};
{
Table[Polygon[c+(xhat#[[1]]+yhat#[[2]])&/@If[j==-1,Identity,Function[f,RotateRight[Reverse[f]]]][{i x[4],i{j,1}x[9],i{j,1}x[7]}]],{i,-1,1,2},{j,-1,1,2}],
Table[Polygon[c+(xhat#[[1]]+yhat#[[2]])&/@({(-1)^i,1}#&/@If[i==2,Identity,Function[f,RotateRight[Reverse[f]]]][{x3,x5,x8,x10,{1,-1}x8,{1,-1}x5}])],{i,2}]
}
]

Unit[v_]:=v/Norm[v]

Show[Graphics3D[{poly=(Polyhedron[RhombicTriacontahedron]/.Polygon[x_]:>StellationPattern[x]),
PointSize[.03],Point[First[#]]&/@Select[First/@Flatten[poly//N],Length[#]>3&],
Line[{#[[1]],#[[1]]+Unit@Cross[#[[2]]-First[#],Last[#]-First[#]]}]&/@Select[First/@Flatten[poly//N],Length[#]>3&]
}],Boxed->False]

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

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

Reorient Hull to Uniform (V14)

{
Graphics3D[{Green,PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"]}],
Graphics3D[{Red,PolyhedronData["GreatRhombicTriacontahedronHull","Polyhedron"]}]
}

Graphics3D[{p=PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v=p[[1]]]}]

phull[[1,92]]

Graphics3D[{phull=PolyhedronData["GreatRhombicTriacontahedronHull","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,vhull=phull[[1]]]}]

rot=Map[ToAlgebraicRoot,RotationMatrix[{Mean[vhull[[{182,177}]]],{0,0,1}}],{2}]

vnew=rot.#&/@vhull;

v[[23]]

{Graphics3D[{Green,PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"]}],Graphics3D[{Red,Polyhedron[vnew,phull[[2]]]}]}

rot2=RotationMatrix[Pi/2,{0,0,1}]

vnew2=rot2.#&/@vnew;

{Graphics3D[{Green,PolyhedronData["GreatRhombicTriacontahedron","Polyhedron"]}],Graphics3D[{Red,Polyhedron[vnew2,phull[[2]]]}]}

Map[RootReduce,vnew2,{2}]//FullSimplify

Messer's Stellation

AppendTo[$Path,"Phosphine:Mathematica Files:Polyhedra:Messer"];
<<M`;
<<StarPack`;
<<RTCStars`;

Show[rtc[JU]]

PolyhedronData

PolyhedronDataString

Graphics3D[{FaceForm[Blue,Red],Polyhedron[GreatRhombicTriacontahedron]}]

PolyhedronDataString[Polyhedron[GreatRhombicTriacontahedron],
"StandardName"->"GreatRhombicTriacontahedronHull",
"Information"->"GreatRhombicTriacontahedron",
"Name"->"great rhombic triacontahedron hull",
Debug->True,
TimeConstraint->600
]

<<MathWorld`Polyhedra`

file=OpenWrite["~/uniform.m"]

WriteString[file,PolyhedronDataString[p,
"Name"->"great rhombic triacontahedron",
"StandardName"->"GreatRhombicTriacontahedron",
"AlternateStandardNames"->{"GreatStellatedTriacontahedron"},
"NotationRules"->{"Stellation"->{"RhombicTiacontahedron",1}},
"Information"->"GreatRhombicTriacontahedron",
"Classes"->{"Stellation","UniformDual","Zonohedron"},
"NotationRules"->{"WenningerDualIndex"->94}
]]

Close[file]