Octahedron 3-Compound

Author

Eric W. Weisstein
October 5, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Octahedron3-Compound.nb.

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

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

Variants

variants=PolyhedronData["OctahedronThreeCompound*"]

PolyhedronData[#,"FaceCount"]&/@variants

Length[PolyhedronData[#,"Polyhedra"]]&/@variants

Polyhedra

GraphicsGrid[Transpose[{
Graphics3D[{PolyhedronData[#,"Polyhedron"]},Boxed->False],
With[{poly=PolyhedronData[#,"Polyhedra"]},Graphics3D[Table[{Hue[(i/(Length[poly]))],poly[[i]]},{i,Length[poly]}],Boxed->False]]
}&/@variants],Dividers->All,ImageSize->700]

Solids and duals

GraphicsGrid[
Table[
With[
{
s={Yellow,PolyhedronData[pname,"Midsphere"]},
dname=PolyhedronData[pname,"Dual","Name"],
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]]
}],
{pname,variants}
],
Dividers->All,ImageSize->800,Alignment->Top
]

Interior and convex hull

GraphicsGrid[
With[{style=Directive[Black,Italic,FontFamily->"Times",16]},
Table[{
Graphics3D[PolyhedronData[pname,"Polyhedron"],PlotLabel->TextCell[Style[PolyhedronData[pname,"Name"],style],PageWidth->200,TextAlignment->Center],Boxed->False],
Graphics3D[{AbsoluteThickness[.5],PolyhedronData[pname,"Lines"],Opacity[.8],PolyhedronData[pname,"CompoundInterior","Polyhedron"]},PlotLabel->Style["interior",style],Boxed->False],
Graphics3D[{
{EdgeForm[None],PolyhedronData[pname,"Polyhedron"]},
{Opacity[.7],EdgeForm[Thickness[.005]],PolyhedronData[pname,"ConvexHull","Polyhedron"]}},PlotLabel->Style["convex hull",style],Boxed->False]
},
{pname,variants}]
],
Dividers->All,ImageSize->700]

TextGrid[
Prepend[
Table[{
pname,
RecognizeGraph@PolyhedronGraph@PolyhedronData[pname,"CompoundInterior","Polyhedron"],
RecognizeGraph@PolyhedronGraph@PolyhedronData[pname,"ConvexHull","Polyhedron"]
},
{pname,variants}],
Thread[Style[{"compound","interior","convex hull"},Bold]]],
Dividers->All]

Polyhedron: {"OctahedronThreeCompound", 1}

Orientations

PolyhedronData[{"OctahedronThreeCompound",1},"Orientations"]

PolyhedronData[{"OctahedronThreeCompound",1}]

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

Polyhedron

Graphics3D[{Opacity[.7],PolyhedronData[{"OctahedronThreeCompound",1},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"OctahedronThreeCompound",1},"Region"]

Solid and dual

PolyhedronData[{"OctahedronThreeCompound",1},#]&/@{"Graphics3D","Dual","DualCompound"}

Graphics3D[{Opacity[.6],
Red,PolyhedronData[{"OctahedronThreeCompound",1},"Polyhedron"],
Green,PolyhedronData[{"OctahedronThreeCompound",1},"Dual","Polyhedron"],
Yellow,PolyhedronData[{"OctahedronThreeCompound",1},"Midsphere"]},Boxed->False]

Polyhedron: {"OctahedronThreeCompound", 2}

Orientations

PolyhedronData[{"OctahedronThreeCompound",2},"Orientations"]

PolyhedronData[{"OctahedronThreeCompound",2},"DefaultOrientation"]

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

Polyhedron

Graphics3D[{Opacity[.8],PolyhedronData[{"OctahedronThreeCompound",2},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"OctahedronThreeCompound",2},"Region"]

Solid and dual

PolyhedronData[{"OctahedronThreeCompound",2},#]&/@{"Graphics3D","Dual","DualCompound"}

Graphics3D[{{Opacity[.6],
Red,PolyhedronData[{"OctahedronThreeCompound",2},"Polyhedron"],
Green,PolyhedronData[{"OctahedronThreeCompound",2},"Dual","Polyhedron"]},
Yellow,PolyhedronData[{"OctahedronThreeCompound",2},"Midsphere"]},Boxed->False]

Polyhedron: {"OctahedronThreeCompound", 3}

Orientations

PolyhedronData[{"OctahedronThreeCompound",3},"Orientations"]

PolyhedronData[{"OctahedronThreeCompound",3},"DefaultOrientation"]

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

Polyhedron

Graphics3D[{Opacity[.8],PolyhedronData[{"OctahedronThreeCompound",3},"Polyhedron"]}]

Face orientation

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

Region

PolyhedronData[{"OctahedronThreeCompound",3},"Region"]

Solid and dual

PolyhedronData[{"OctahedronThreeCompound",3},#]&/@{"Graphics3D","Dual","DualCompound"}

Graphics3D[{{Opacity[.6],
Red,PolyhedronData[{"OctahedronThreeCompound",3},"Polyhedron"],
Green,PolyhedronData[{"OctahedronThreeCompound",3},"Dual","Polyhedron"]},
Yellow,PolyhedronData[{"OctahedronThreeCompound",3},"Midsphere"]},Boxed->False]

Properties: {"OctahedronThreeCompound", 1}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"OctahedronThreeCompound",1},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Beveled

Graphics3D[Bevel[p,.04],Boxed->False]

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

RecognizeGraph@PolyhedronGraph@interior

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[interior]]//Counts//Quiet

lengths=Keys[%]

FullSimplify[(lengths/(Min[lengths]))]

PolyhedronData["TetrakisHexahedron","EdgeLengths"]

MyCircumsphere[interior]//Quiet

Insphere[interior]//Quiet

Midsphere[interior]

Construction

int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]

Graphics3D[int]

Graphics3D[{{Opacity[.3],p},Red,int},Boxed->False]

Union[Chop@int[[1]]]//Length

Exactify

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=inthull[[2]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

pname

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

PolyhedronData["PentakisDodecahedron","EdgeLengths"]

Divide@@%//N

RootReduce[PolyhedronEdgeLengths[PolyhedronData["PentakisDodecahedron","Polyhedron"]]]//Counts

newi[[1]]

newi[[2]]

RootApproximant[((newi[[1]])/(Max[PolyhedronEdgeLengths[newi]])),4]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],newi},Boxed->False]

Find scale

intname=XXX;

PolyhedronData/@{pname,intname}

xyratio=((Max[Norm/@vexact[[All,;;2]]])/(Max[Norm/@PolyhedronData[intname,"VertexCoordinates"][[All,;;2]]]))//RootReduce//FullSimplify//Quiet

zratio=((Max[vexact[[All,3]]])/(Max[PolyhedronData[intname,"VertexCoordinates"][[All,3]]]))//RootReduce//FullSimplify

{xyratio,xyratio,zratio}

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[convexhullreg=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]

v=PolyhedronCoordinates[convexhullreg]

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

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

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

Find rotation matrix

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

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

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

Find rotation matrix

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

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

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

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])//Timing

(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

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

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"]

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

l={{gn,{0,Union[emb,{pname}]}}}

PropertyReplace[l,"PolyhedralEmbeddings","14.0"]

pname

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

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

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]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"OctahedronThreeCompound", 2}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"OctahedronThreeCompound",2},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

MyCircumsphere[interior]//Quiet

Insphere[interior]//Quiet

Midsphere[interior]

Construction

int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]

Graphics3D[int]

Graphics3D[{{Opacity[.3],p},Red,int},Boxed->False]

PolyhedronFaceTally[int]

Union[Chop@int[[1]]]//Length

Exactify

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]//ToRadicals

faces=inthull[[2]]

pname

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

PolyhedronData["PentakisDodecahedron","EdgeLengths"]

Divide@@%//N

RootReduce[PolyhedronEdgeLengths[PolyhedronData["PentakisDodecahedron","Polyhedron"]]]//Counts

newi[[1]]

newi[[2]]

RootApproximant[((newi[[1]])/(Max[PolyhedronEdgeLengths[newi]])),4]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],newi},Boxed->False]

Find scale

intname=XXX;

PolyhedronData/@{pname,intname}

xyratio=((Max[Norm/@vexact[[All,;;2]]])/(Max[Norm/@PolyhedronData[intname,"VertexCoordinates"][[All,;;2]]]))//RootReduce//FullSimplify//Quiet

zratio=((Max[vexact[[All,3]]])/(Max[PolyhedronData[intname,"VertexCoordinates"][[All,3]]]))//RootReduce//FullSimplify

{xyratio,xyratio,zratio}

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

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

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

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

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

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

Show[%]

Construct using ConvexHullRegion

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

v=PolyhedronCoordinates[convexhullreg]

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

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

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

Find rotation matrix

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

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

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

Find rotation matrix

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

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

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

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

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

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

Map[ToAlgebraicRoot,i,{2}]

PolyhedronInertiaTensor[p]//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.5],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])//Timing

(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

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

Skeleton

PolyhedronData[pname,"Skeleton"]

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

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

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

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

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]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Properties: {"OctahedronThreeCompound", 3}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"OctahedronThreeCompound",3},"Polyhedron"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

(sphere=MyCircumsphere[p]//FullSimplify)//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

intname=PolyhedronData[pname,"CompoundInterior","Name"]

PolyhedronData[pname,"CompoundInterior","Scale"]

PolyhedronData[pname,"CompoundInterior","RotationMatrix"]

PolyhedronData[pname,"CompoundInterior"]

Graphics3D[{
AbsoluteThickness[1],PolyhedronData[pname,"Lines"],
Opacity[.8],interior=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

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

MyCircumsphere[interior]//Quiet

Insphere[interior]//RootReduce//Quiet

Midsphere[interior]

Construction

int=RegionIntersection[Sequence@@PolyhedronData[pname,"Polyhedra"],PerformanceGoal->"Quality"]

Graphics3D[int]

Graphics3D[{{Opacity[.3],p},Red,int},Boxed->False]

Numerically group

Union[Chop@int[[1]]]//Length

Length[grouped=SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[int[[1]]],Last],Last][[All,All,1]]]

Max[EuclideanDistance@@@Flatten[Subsets[#,{2}]&/@grouped,1]]

grouped//Column

rules=Flatten[Function[l,Rule[#,Mean[l]]&/@l]/@grouped,1];

newi=ConvexHullRegion[DeleteDuplicates[Chop[int[[1]]]/.rules]]

Graphics3D[LabelPolyhedron@newi]

Midsphere[newi]

RecognizeGraph@PolyhedronGraph@newi

lengths=PolyhedronEdgeLengths[newi]

Divide@@MinMax[%lengths]

Round[10^12lengths]/10^12.//Counts

newi[[1]]

Sort[newi[[2]]]

Graphics3D[{
AbsoluteThickness[.1],PolyhedronData[pname,"Lines"],
Opacity[.8],newi},Boxed->False]

Exactify: RootApproximant

vexact=DeleteDuplicates[RootApproximant[Chop[int[[1]]]]]

Length[vexact]

Exactify: ToAlgebraicRoot

vexact=DeleteDuplicates[Map[ToAlgebraicRoot[SetPrecision[#,14],"MaxDegree"->4]&,Chop[int[[1]]],{2}]]

Length[vexact]

Plane intersections

polygons=PolyhedronData[pname,"Polygons"]

Length@polygons

Binomial[%,3]

Length[intersections=RegionIntersection@@@Subsets[InfinitePlane@@@polygons,{3}]]//Timing

Length[pts=Cases[intersections,Point[x_]:>Flatten[x]]]

Length[pts2=Select[pts,Min[Abs[Denominator[#]]]>1*^-100&]]//Quiet//Timing

Graphics3D[{AbsolutePointSize[5],Point[N[pts2]],Opacity[.2],p},PlotRange->.7]

groupednorms=Mean/@SplitBy[SortBy[{#,Round[1*^12#]}&/@Chop[Norm/@int[[1]]],Last],Last][[All,All,1]]

normineqs[l_,dx_:.01]:=Function[Evaluate[Or@@(Function[f,f-dx<=Norm[#]<=f+dx]/@l)]]

ineq=normineqs[groupednorms,.0001]

Length[pts3=Select[pts2,ineq]]//Quiet//Timing

Graphics3D[{AbsolutePointSize[5],Point[N[pts3]],Opacity[.2],p},PlotRange->.7]

Length[pts4=DeleteDuplicates[Map[ToAlgebraicRoot,pts3,{2}]]]//Timing

Graphics3D[{AbsolutePointSize[5],Point[pts4],{Opacity[0],p},Red,ConvexHullRegion[pts4]},PlotRange->.6]

vexact=pts4

Exact interior

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=Sort[inthull[[2]]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

GraphData[gname,"PolyhedralEmbeddings"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[inthull]]//Counts//Quiet

pname

Concave

PolyhedronData[pname,"Concave"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]//Timing

ConvexHull

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

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

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

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

pname

Counts[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]]

Keys[%]//N

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

Show[%]

Construct using ConvexHullRegion

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

v=PolyhedronCoordinates[convexhullreg]

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

Find scale

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhullreg]]//Tally//FullSimplify

((Max[p[[1]][[All,3]]])/(Max[PolyhedronData[convexhullname,"Polyhedron"][[1]][[All,3]]]))//RootReduce//Quiet

ConvexHullOf

hullof=DeleteCases[Select[PolyhedronData[All],PolyhedronData[#,"ConvexHullName"]===pname&],pname]

GraphicsGrid[Partition[Graphics3D[{
{Green,Opacity[.7],PolyhedronData[#,"Polyhedron"]},
{Blue,Opacity[.2],PolyhedronData[#,"ConvexHull","Polyhedron"]}},Boxed->False,PlotLabel->Style[PolyhedronData[#,"Name"],Directive[14,Black,Italic,FontFamily->"Times"]]]&/@hullof,UpTo[3]],Dividers->All,ImageSize->800]

DehnInvariant

PolyhedronData[pname,"DehnInvariant"]

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

ToConwayBasis[dehn]

Complement[Select[PolyhedronData[All],PolyhedronData[#,"DehnInvariant"]==dehn&&PolyhedronData[#,"Volume"]==vol&],{pname}]

DihedralAngles

(dih1=PolyhedronData[pname,"DihedralAngles"])//Tally

(dih2=SimplifyNumericallyDistinct[DihedralAngles[p]])//Tally

dih1===dih2

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[lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p],"Simplification"->RootReduce]//FullSimplify]//Timing

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//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/@p[[1]]])/(Max[Norm/@PolyhedronData[hullname,"Polyhedron"][[1]]]))//FullSimplify//Quiet

PolyhedronData[pname,"Hull"]

Max[Norm/@PolyhedronData[pname,"Hull","Polyhedron"][[1]]]

Max[Norm/@p[[1]]]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

Find rotation matrix

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

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

{Graphics3D[{Polyhedron[newv=rot.#&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

ArcTan@@(Most@Mean[newv[[{7,29}]]])//FullSimplify

rot2=RotationMatrix[Pi/2+2Pi/5,{0,0,1}].rot//FullSimplify

{Graphics3D[{Polyhedron[(rot2.#)&/@basesolid[[1]],basesolid[[2]]],MapIndexed[Text[#2[[1]],#,Background->White]&,basesolid[[1]]]}],
Graphics3D[ConvexHullRegion[PolyhedronData[pname,"Vertices"]]]}

HullOf

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

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

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[p]

Graphics3D[{{Opacity[.3],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])//Timing

(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

polyhedra=PolyhedronData[pname,"Polyhedra"]

Length[polyhedra]

Graphics3D[polyhedra]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}]]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]//Timing

Skeleton

PolyhedronData[pname,"Skeleton"]

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

GraphData[gn]

emb=GraphData[gn,"PolyhedralEmbeddings"]

l={{gn,{0,Union[emb,{pname}]}}}

PropertyReplace[l,"PolyhedralEmbeddings","14.0"]

RenameGraphFiles[]

pname

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

g=PolyhedronGraph[p]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]

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

SurfaceArea[PolyhedronData[pname,"Region"]]

Uniform

PolyhedronData[pname,"Uniform"]

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]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Volume[PolyhedronData[pname,"Region"]]//FullSimplify

Volume[ImplicitRegion[Evaluate@PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]]//FullSimplify

WythoffSymbol

PolyhedronData[pname,"WythoffSymbol"]

Construction

<<MathWorld`Polyhedra`

{"OctahedronThreeCompound", 1} from dual

poly=PolyhedronData[{"CubeThreeCompound",1},"Polyhedra"]

duals=PlatonicDual/@poly

Graphics3D[duals]

Graphics3D/@Transpose[{poly,duals}]

Show[%]

vduals=duals[[All,1]]//RootReduce

Length[Flatten[vduals,1]]

Length[v=DeleteDuplicates[Flatten[vduals,1]]]

faces=RootReduce[(Function[f,#[[1]][[f]]]/@#[[2]])&/@duals]/.Thread[v->Range@Length@v]//Quiet

Flatten[faces,1]

Graphics3D[compound=Polyhedron[FullSimplify@v,Flatten[faces,1]]]

{"OctahedronThreeCompound", 1} pieces

<<PolyhedronOperations`;
<<Platonic`;
<<SolidGeometry`;
<<Simplify`;
Off[$MaxExtraPrecision::"meprec"];

poly=Flatten[Polyhedron[Octahedron3Compound]];

FaceIntersections[poly_]:=Module[{pairs=KSubsets[Take[#,3]&/@First/@poly,2]},
DeleteCases[Intersection3D@@@Map[Plane,pairs,{2}],{}]
]

Timing[Length[lines=FaceIntersections[poly]]]

Timing[Length[points=Intersection3D@@@KSubsets[lines,2]]]

Show[Graphics3D[{Polyhedron[poly],{Red,lines},PointSize[.02],points}]]

Timing[Length[p=First/@Union[Select[DeleteCases[points,{}],#[[1]].#[[1]]≤1.25&]]]]

Timing[Length[p2=Union[Map[Simplify,p,{2}]]]]

p2={{-1,0,0},{-1,0,1-(Sqrt[2])},{-1,0,-1+(Sqrt[2])},{-1,1-(Sqrt[2]),0},{-1,-1+(Sqrt[2]),0},{0,-1,0},{0,-1,1-(Sqrt[2])},{0,-1,-1+(Sqrt[2])},{0,0,-1},{0,0,1},{0,0,-(1/(Sqrt[2]))},{0,0,(1/(Sqrt[2]))},{0,1,0},{0,1,1-(Sqrt[2])},{0,1,-1+(Sqrt[2])},{0,-(1/(Sqrt[2])),0},{0,-(1/(Sqrt[2])),-(1/(Sqrt[2]))},{0,-(1/(Sqrt[2])),(1/(Sqrt[2]))},{0,-(1/(Sqrt[2])),(1/2)-(1/(Sqrt[2]))},{0,-(1/(Sqrt[2])),-(1/2)+(1/(Sqrt[2]))},{0,(1/(Sqrt[2])),0},{0,(1/(Sqrt[2])),-(1/(Sqrt[2]))},{0,(1/(Sqrt[2])),(1/(Sqrt[2]))},{0,(1/(Sqrt[2])),(1/2)-(1/(Sqrt[2]))},{0,(1/(Sqrt[2])),-(1/2)+(1/(Sqrt[2]))},{0,(1/2)-(1/(Sqrt[2])),-(1/(Sqrt[2]))},{0,(1/2)-(1/(Sqrt[2])),(1/(Sqrt[2]))},{0,-(1/2)+(1/(Sqrt[2])),-(1/(Sqrt[2]))},{0,-(1/2)+(1/(Sqrt[2])),(1/(Sqrt[2]))},{0,1-(Sqrt[2]),-1},{0,1-(Sqrt[2]),1},{0,-1+(Sqrt[2]),-1},{0,-1+(Sqrt[2]),1},{1,0,0},{1,0,1-(Sqrt[2])},{1,0,-1+(Sqrt[2])},{1,1-(Sqrt[2]),0},{1,-1+(Sqrt[2]),0},{-(1/(Sqrt[2])),0,0},{-(1/(Sqrt[2])),0,-(1/(Sqrt[2]))},{-(1/(Sqrt[2])),0,(1/(Sqrt[2]))},{-(1/(Sqrt[2])),0,(1/2)-(1/(Sqrt[2]))},{-(1/(Sqrt[2])),0,-(1/2)+(1/(Sqrt[2]))},{-(1/(Sqrt[2])),-(1/(Sqrt[2])),0},{-(1/(Sqrt[2])),(1/(Sqrt[2])),0},{-(1/(Sqrt[2])),(1/2)-(1/(Sqrt[2])),0},{-(1/(Sqrt[2])),-(1/2)+(1/(Sqrt[2])),0},{(1/(Sqrt[2])),0,0},{(1/(Sqrt[2])),0,-(1/(Sqrt[2]))},{(1/(Sqrt[2])),0,(1/(Sqrt[2]))},{(1/(Sqrt[2])),0,(1/2)-(1/(Sqrt[2]))},{(1/(Sqrt[2])),0,-(1/2)+(1/(Sqrt[2]))},{(1/(Sqrt[2])),-(1/(Sqrt[2])),0},{(1/(Sqrt[2])),(1/(Sqrt[2])),0},{(1/(Sqrt[2])),(1/2)-(1/(Sqrt[2])),0},{(1/(Sqrt[2])),-(1/2)+(1/(Sqrt[2])),0},{(1/2)-(1/(Sqrt[2])),0,-(1/(Sqrt[2]))},{(1/2)-(1/(Sqrt[2])),0,(1/(Sqrt[2]))},{(1/2)-(1/(Sqrt[2])),-(1/(Sqrt[2])),0},{(1/2)-(1/(Sqrt[2])),(1/(Sqrt[2])),0},{-(1/2)+(1/(Sqrt[2])),0,-(1/(Sqrt[2]))},{-(1/2)+(1/(Sqrt[2])),0,(1/(Sqrt[2]))},{-(1/2)+(1/(Sqrt[2])),-(1/(Sqrt[2])),0},{-(1/2)+(1/(Sqrt[2])),(1/(Sqrt[2])),0},{(1/3) (1-2 (Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1-2 (Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (1+(Sqrt[2]))},{1-(Sqrt[2]),-1,0},{1-(Sqrt[2]),0,-1},{1-(Sqrt[2]),0,1},{1-(Sqrt[2]),1,0},{1-(Sqrt[2]),1-(Sqrt[2]),1-(Sqrt[2])},{1-(Sqrt[2]),1-(Sqrt[2]),-1+(Sqrt[2])},{1-(Sqrt[2]),-1+(Sqrt[2]),1-(Sqrt[2])},{1-(Sqrt[2]),-1+(Sqrt[2]),-1+(Sqrt[2])},{(1/3) (-1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (1+(Sqrt[2]))},{-1+(Sqrt[2]),-1,0},{-1+(Sqrt[2]),0,-1},{-1+(Sqrt[2]),0,1},{-1+(Sqrt[2]),1,0},{-1+(Sqrt[2]),1-(Sqrt[2]),1-(Sqrt[2])},{-1+(Sqrt[2]),1-(Sqrt[2]),-1+(Sqrt[2])},{-1+(Sqrt[2]),-1+(Sqrt[2]),1-(Sqrt[2])},{-1+(Sqrt[2]),-1+(Sqrt[2]),-1+(Sqrt[2])},{(1/3) (1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1-2 (Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (1+(Sqrt[2])),(1/3) (-1+2 (Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2])))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((2+(Sqrt[2]))/(-4-3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2])))},{((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((2+(Sqrt[2]))/(4+3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{-((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2])))},{-((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2])))},{-((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2])))},{-((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2])))},{((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2])))},{((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2])))},{((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2]))),-((Sqrt[2])/(2+(Sqrt[2])))},{((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2]))),((Sqrt[2])/(2+(Sqrt[2])))},{((2+(Sqrt[2]))/(-4-3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((2+(Sqrt[2]))/(-4-3 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (-1-(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (1-(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (-1-(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (-1+(Sqrt[2])),(1/3) (1+(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (1-(Sqrt[2]))},{(1/3) (-1+2 (Sqrt[2])),(1/3) (1+(Sqrt[2])),(1/3) (-1+(Sqrt[2]))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2])))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((2+(Sqrt[2]))/(-4-3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2])))},{((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((2+(Sqrt[2]))/(4+3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2])))},{((2+(Sqrt[2]))/(4+3 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((2+(Sqrt[2]))/(4+3 (Sqrt[2]))),((1+(Sqrt[2]))/(3+2 (Sqrt[2]))),((1+(Sqrt[2]))/(-3-2 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(-7-4 (Sqrt[2])))},{((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2]))),((1+3 (Sqrt[2]))/(7+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((10-(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-10+(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((10-(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((-10+(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((10+3 (Sqrt[2]))/(-16-13 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((10+3 (Sqrt[2]))/(16+13 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((18+7 (Sqrt[2]))/(-32-25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((18+7 (Sqrt[2]))/(-32-25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((10+3 (Sqrt[2]))/(-16-13 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((3+5 (Sqrt[2]))/(13+8 (Sqrt[2])))},{((3+5 (Sqrt[2]))/(13+8 (Sqrt[2]))),((10+3 (Sqrt[2]))/(16+13 (Sqrt[2]))),((3+5 (Sqrt[2]))/(-13-8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((18-(Sqrt[2]))/(16+17 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-18+(Sqrt[2]))/(16+17 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((18-(Sqrt[2]))/(16+17 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((-1+9 (Sqrt[2]))/(17+8 (Sqrt[2]))),((-18+(Sqrt[2]))/(16+17 (Sqrt[2]))),((1-9 (Sqrt[2]))/(17+8 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((18+7 (Sqrt[2]))/(-32-25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((18+7 (Sqrt[2]))/(32+25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((10-(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((10-(Sqrt[2]))/(8+9 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-10+(Sqrt[2]))/(8+9 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((-10+(Sqrt[2]))/(8+9 (Sqrt[2]))),((-1+5 (Sqrt[2]))/(9+4 (Sqrt[2]))),((1-5 (Sqrt[2]))/(9+4 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((18+7 (Sqrt[2]))/(-32-25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2])))},{((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((18+7 (Sqrt[2]))/(32+25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((18+7 (Sqrt[2]))/(32+25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))},{((18+7 (Sqrt[2]))/(32+25 (Sqrt[2]))),((7+9 (Sqrt[2]))/(25+16 (Sqrt[2]))),((7+9 (Sqrt[2]))/(-25-16 (Sqrt[2])))}};

Show[Graphics3D[{Polyhedron[Octahedron3Compound],
PointSize[.02],
Point/@p2,
MapIndexed[Text[#2[[1]],#1+{0,0,.05},Background->White]&,p2]
}],Boxed->False]

dist[i_,j_]:=Sqrt[#.#&[i-j]]

FullSimplify/@(dist[p2[[#1]],p2[[#2]]]&@@@Partition[{18,27,235},2,1,1])

N[%]

<<Simplify`

poly2d=Polygon2D[poly2]//N

poly2d//N

Partition[poly2d[[1]],2,1,1]//N

(dist[#1,#2]&@@@Partition[poly2d[[1]],2,1,1])//N

poly1=Map[ToExact,Polygon[p2[[{225,10,235,27}]]],{3}][[1]]

poly2=Map[ToExact,Polygon[p2[[{18,235,27}]]],{3}][[1]]

Show[Graphics[{
poly3=Polygon2D[poly1]/.Polygon[x_]:>ClosedLine[RotationMatrix[α].#&/@({#[[1]],-#[[2]]}&/@x)],
Polygon2D[poly2]/.Polygon[x_]:>ClosedLine[{-#[[1]],-#[[2]]}&/@x]
}],AspectRatio->Automatic]

(q=(Polygon2D[poly1]/.Polygon[x_]:>ClosedLine[({#[[1]],-#[[2]]}&/@x)])[[1]])//N

α=ArcTan@@q[[-3]];

poly3//N

poly3=ToExact/@(#-poly3[[1,2]]&/@poly3[[1]])

Show[Graphics[{
ClosedLine/@Table[{{Cos[i Pi/3],Sin[i Pi/3]},{-Sin[i Pi/3],Cos[i Pi/3]}}.#&/@poly3,{i,0,3}]
}],AspectRatio->Automatic]

poly2

poly4=Polygon2D[poly2[[{1,2,3}]]][[1]];

N[poly4=-(#-poly4[[1]])&/@poly4]

α=2ArcTan@@(poly4[[1]]-poly4[[2]]);
poly5={{Cos[α],Sin[α]},{-Sin[α],Cos[α]}}.#&/@poly4;

Show[Graphics[{
ClosedLine/@{poly4,{#[[1]],-#[[2]]}&/@poly4},
ClosedLine/@{poly5,{#[[1]],-#[[2]]}&/@poly5}
}],AspectRatio->Automatic,PlotRange->All]

Show[Graphics[net={
ClosedLine/@Table[{{Cos[i Pi/3],Sin[i Pi/3]},{-Sin[i Pi/3],Cos[i Pi/3]}}.#&/@poly3,{i,0,3}],
ClosedLine/@{poly4,{#[[1]],-#[[2]]}&/@poly4}/.Line[x_]:>Line[{3/2,0}+#&/@x],
ClosedLine/@{poly5,{#[[1]],-#[[2]]}&/@poly5}/.Line[x_]:>Line[{3/2,0}+#&/@x]
}],AspectRatio->Automatic]

net2=Map[ToExact,Flatten[net],{3}]

v=Union[Flatten[First/@net2,1]];

Drop[First[#],-1]&/@net2/.Thread[v->Range[Length[v]]]

v//InputForm

<<Platonic`

Show[Graphics[NetDiagram[Octahedron3Compound]],AspectRatio->Automatic]

Sort[DeleteCases[Union[NetEdgeLengths[Octahedron3Compound]//FullSimplify],0],Less]

%//N

NetSurfaceArea[Octahedron3Compound]//FullSimplify

NetSurfaceArea[Octahedron3Compound]//RootReduce//ToRadicals

N[%]

PolyhedronSurfaceArea[Polyhedron[Octahedron]]//N

PolyhedronEdgeLengths[Polyhedron[Octahedron3Compound]]//FullSimplify

{"OctahedronThreeCompound", 2} from olyhedronRotationCompound[PolyhedronData[{"Octahedron", "C4"}, "Polyhedron"], "C4", 3]

Graphics3D[compound=PolyhedronRotationCompound[PolyhedronData[{"Octahedron","C4"},"Polyhedron"],"C4",3]]

{"OctahedronThreeCompound", 2} from Dual

poly=PolyhedronData[{"CubeThreeCompound",2},"Polyhedra"]

duals=PlatonicDual/@poly

Graphics3D[duals]

Graphics3D/@Transpose[{poly,duals}]

Show[%]

vduals=duals[[All,1]]//RootReduce

Length[Flatten[vduals,1]]

Length[v=DeleteDuplicates[Flatten[vduals,1]]]

faces=RootReduce[(Function[f,#[[1]][[f]]]/@#[[2]])&/@duals]/.Thread[v->Range@Length@v]//Quiet

Flatten[faces,1]

Graphics3D[compound=Polyhedron[FullSimplify@v,Flatten[faces,1]]]

{"OctahedronThreeCompound", 3} from PolyhedronRotationCompound[PolyhedronData[{"Octahedron", "C3"}, "Polyhedron"], "C3", 3]

Graphics3D[compound=PolyhedronRotationCompound[PolyhedronData[{"Octahedron","C3"},"Polyhedron"],"C3",3]]

{"OctahedronThreeCompound", 3} from dual

poly=PolyhedronData[{"CubeThreeCompound",3},"Polyhedra"]

duals=PlatonicDual/@poly

Graphics3D[duals]

Graphics3D/@Transpose[{poly,duals}]

Show[%]

vduals=duals[[All,1]]//RootReduce

Length[Flatten[vduals,1]]

Length[v=DeleteDuplicates[Flatten[vduals,1]]]

faces=RootReduce[(Function[f,#[[1]][[f]]]/@#[[2]])&/@duals]/.Thread[v->Range@Length@v]//Quiet

Flatten[faces,1]

Graphics3D[compound=Polyhedron[FullSimplify@v,Flatten[faces,1]]]

{"OctahedronThreeCompound", 4} XXX

?PolyhedronRotationCompound

Graphics3D[compound=PolyhedronRotationCompound[PolyhedronData[{"Octahedron","C2"},"Polyhedron"],"C2",3]]

Octahedron3Compound:=Module[{o,o2,l},
{
o=OctahedronExact/.Polygon[l_List]:>Polygon[RotationMatrixZ[Pi/4].#&/@l],
o2=o/.Polygon[l_List]:>Polygon[RotationMatrixX[Pi/2].#&/@l],
o2/.Polygon[l_List]:>Polygon[RotationMatrixZ[Pi/2].#&/@l]
}
]

PolyhedronData

PolyhedronDataString

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

WriteString[file,With[
{
base="Octahedron",
n=3,
facecnt=PolyhedronFaceCount[compound],
ind=3
},
PolyhedronDataString[compound,
"StandardName"->{base<>Capitalize[IntegerName[n]]<>"Compound",ind},
"AlternateStandardNames"->{},
"Name"->IntegerName[ind,"Ordinal"]<>" "<>ToLowerCase[base]<>" "<>ToString[n]<>"\[Hyphen]compound",
"Information"->base<>ToString[n]<>"-Compound",
"PolyhedronIndices"->"Partition[Range["<>ToString[facecnt]<>"], "<>ToString[facecnt/n]<>"]",
"Classes"->{"Compound"}
]]]

Close[file]