Cube 6-Compound

Author

Eric W. Weisstein
September 21, 2023

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

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

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

Variants

variants=PolyhedronData["CubeSixCompound*"]

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

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[1],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]

Polyhedron: {"CubeSixCompound", 1}

Orientations

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

PolyhedronData[{"CubeSixCompound",1},"DefaultOrientation"]

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

Polyhedron

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

Face orientation

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

Polyhedra

Length[polyhedra=PolyhedronData[{"CubeSixCompound",1},"Polyhedra"]]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}],Boxed->False]

Region

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

Solid and dual

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

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

Polyhedron: {"CubeSixCompound", 2}

Orientations

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

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

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

Polyhedron

Graphics3D[{Opacity[.7],PolyhedronData[{"CubeSixCompound",2},"Polyhedron"]}]

Face orientation

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

Polyhedra

Length[polyhedra=PolyhedronData[{"CubeSixCompound",2},"Polyhedra"]]

Graphics3D[Table[{Hue[(i/(Length[polyhedra]))],polyhedra[[i]]},{i,Length[polyhedra]}],Boxed->False]

Region

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

Solid and dual

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

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

Polyhedron: {"CubeSixCompound", 3} [not added to PolyhedronData]

Show[Graphics3D[PolyhedronRotationCompound[Polyhedron[Cube]//N,5]],Boxed->False]

Properties: {"CubeSixCompound", 1}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"CubeSixCompound",1},"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],PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

Construction

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

Graphics3D[int]

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

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

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

Length[vexact]

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=inthull[[2]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

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

RecognizeGraph@PolyhedronGraph@convexhull

{
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[.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

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

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

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: {"CubeSixCompound", 2}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"CubeSixCompound",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],int=PolyhedronData[pname,"CompoundInterior","Polyhedron"]},Boxed->False]

MyCircumsphere[int]//Quiet

Insphere[int]//Quiet

Midsphere[int]

Construction

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

Graphics3D[int]

Circumsphere[int]//Quiet

Insphere[int]//Quiet

Midsphere[int]//Quiet

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

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

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

Length[vexact]

inthull=ConvexHullRegion[Union@vexact]

v=inthull[[1]]

faces=inthull[[2]]

gname=RecognizeGraph@PolyhedronGraph[inthull]

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

RecognizeGraph@PolyhedronGraph@convexhull

{
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[.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

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

pname

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

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

{"CubeSixCompound", 1}

cube=RotateAboutAxis[Polyhedron[Cube][[1]],{1,1,0},Pi/2];
cubes={cube,RotateAboutAxis[cube,{0,0,1},Pi/2]};

Show[Graphics3D[poly={
cubes,
RotateAboutAxis[#,{1,0,0},Pi/2]&/@cubes,
RotateAboutAxis[#,{0,1,0},Pi/2]&/@cubes
}],Boxed->False]

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

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

{"CubeSixCompound", 1} Pieces

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

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

Timing[Length[lines=Map[Simplify,FaceIntersections[Flatten@Polyhedron[Cube6Compound,"C3"]],{3}]]]

Timing[Length[lines2=Map[ToExact,lines,{3}]]]

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

Timing[Length[p=Simplify[First/@Union[Select[DeleteCases[points,{}],#[[1]].#[[1]]≤1.2&&#[[1,2]]<0&]]]]]

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

Show[Graphics3D[{Polyhedron[Cube6Compound,"C3"],
PointSize[.003],
Point/@N[p2],
MapIndexed[Text[#2[[1]],#1+{0,0,.007},Background->White]&,N[p2]]
}],Boxed->False,ViewPoint->{-0,-1.5,.2}]

q6=p2[[{24,288,386,291}]]

r6=ToExact/@Polygon2D[q6][[1]]

q5=p2[[{315,418,79,321,192,200,247,20,230,539,432}]]

r5=ToExact/@Polygon2D[q5][[1]]

q4=p2[[{10,200,247}]]

r4=ToExact/@Polygon2D[q4][[1]]

q3=p2[[{10,20,247}]]

r3=ToExact/@Polygon2D[q3][[1]]

q2=p2[[{83,337,330,230}]]

r2=ToExact/@Polygon2D[q2][[1]]

q1=p2[[{10,86,337,83}]]

r1=ToExact/@Polygon2D[q1][[1]]

Show[Graphics[piece1=ClosedLine/@{
rr1=RotationMatrix[Pi/4].#&/@r1,
rr3=rr1[[-1]]-rr1[[1]]+#&/@(rr2=RotationMatrix[Pi/4].#&/@r2),
{rr3[[2,1]]-#[[1]],#[[2]]}&/@rr3
}],AspectRatio->Automatic]

Show[Graphics[piece2=ClosedLine/@{
r3,
{#[[1]],-#[[2]]}&/@r4
}],AspectRatio->Automatic]

Show[Graphics[piece3=ClosedLine/@{
r5,
{#[[1]],-#[[2]]}&/@r5,
rr63=#-{0,rr62[[2,2]]}&/@(rr62={#[[1]],-#[[2]]}&/@(RotationMatrix[Pi+Pi/4+ArcTan@@rr6[[2]]].#&/@(rr6=#-r6[[-1]]&/@r6))),
r5[[-1]]-#&/@rr63
}],AspectRatio->Automatic]

Show[Graphics[net={piece3,
piece2/.Line[x_]:>Line[{5/2-1/4,0}+#&/@x],
piece1/.Line[x_]:>Line[{3/2,1/8}+#&/@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[Net[Cube6Compound,"C3"]],AspectRatio->Automatic]

<<Platonic`

<<Simplify`

Off[$MaxExtraPrecision::"meprec"];

s=SqrtSimplify/@ToExact/@NetEdgeLengths[Cube6Compound,"C3"]

sides=Sort[Union[s],Less]

sides//N

lengths=Sort[Transpose[{s/.Thread[sides->Range[Length[sides]]],NetEdges[Cube6Compound,"C3"]}]]

<<PolyhedronOperations`

Show[Graphics[NetDiagram[Cube6Compound,"C3"]],AspectRatio->Automatic]

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

Show[Graphics[net={n=Net[Cube6Compound,"C3"],
n[[3]]/.Line[x_]:>Line[{5+1/2-#[[1]],#[[2]]}&/@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

FullSimplify[n[[3]]/.Line[x_]:>Line[{5+1/2-#[[1]],#[[2]]}&/@x]]

Net[Cube6Compound,"C3"][[3]]

<<Platonic`

Show[Graphics[Net[Cube6Compound,"C3"]],AspectRatio->Automatic]

Show[Graphics[NetDiagram[Cube6Compound,"C3"]],AspectRatio->Automatic]

Sort[Union[NetEdgeLengths[Cube6Compound,"C3"]//FullSimplify//ToRadicals],Less]

N[%]

NetSurfaceArea[Cube6Compound,"C3"]//Simplify

N[%]

PolyhedronEdgeLengths[Polyhedron[Cube6Compound,"C3"]]//FullSimplify

{"CubeSixCompound", 2}

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

poly=Map[ToExact,Flatten[PolyhedronRotationCompound[Polyhedron[Cube],3]],{3}];

Partition[Range[6 6],6]

(v=PolyhedronVertices[poly])//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

compound=Polyhedron[{{-1/2,(-1-Sqrt[3])/4,(1-Sqrt[3])/4},{-1/2,(-1-Sqrt[3])/4,(-1+Sqrt[3])/4},{-1/2,(1-Sqrt[3])/4,(-1-Sqrt[3])/4},{-1/2,(1-Sqrt[3])/4,(1+Sqrt[3])/4},{-1/2,(-1+Sqrt[3])/4,(-1-Sqrt[3])/4},{-1/2,(-1+Sqrt[3])/4,(1+Sqrt[3])/4},{-1/2,(1+Sqrt[3])/4,(1-Sqrt[3])/4},{-1/2,(1+Sqrt[3])/4,(-1+Sqrt[3])/4},{1/2,(-1-Sqrt[3])/4,(1-Sqrt[3])/4},{1/2,(-1-Sqrt[3])/4,(-1+Sqrt[3])/4},{1/2,(1-Sqrt[3])/4,(-1-Sqrt[3])/4},{1/2,(1-Sqrt[3])/4,(1+Sqrt[3])/4},{1/2,(-1+Sqrt[3])/4,(-1-Sqrt[3])/4},{1/2,(-1+Sqrt[3])/4,(1+Sqrt[3])/4},{1/2,(1+Sqrt[3])/4,(1-Sqrt[3])/4},{1/2,(1+Sqrt[3])/4,(-1+Sqrt[3])/4},{(-1-Sqrt[3])/4,-1/2,(1-Sqrt[3])/4},{(-1-Sqrt[3])/4,-1/2,(-1+Sqrt[3])/4},{(-1-Sqrt[3])/4,1/2,(1-Sqrt[3])/4},{(-1-Sqrt[3])/4,1/2,(-1+Sqrt[3])/4},{(-1-Sqrt[3])/4,(1-Sqrt[3])/4,-1/2},{(-1-Sqrt[3])/4,(1-Sqrt[3])/4,1/2},{(-1-Sqrt[3])/4,(-1+Sqrt[3])/4,-1/2},{(-1-Sqrt[3])/4,(-1+Sqrt[3])/4,1/2},{(1-Sqrt[3])/4,-1/2,(-1-Sqrt[3])/4},{(1-Sqrt[3])/4,-1/2,(1+Sqrt[3])/4},{(1-Sqrt[3])/4,1/2,(-1-Sqrt[3])/4},{(1-Sqrt[3])/4,1/2,(1+Sqrt[3])/4},{(1-Sqrt[3])/4,(-1-Sqrt[3])/4,-1/2},{(1-Sqrt[3])/4,(-1-Sqrt[3])/4,1/2},{(1-Sqrt[3])/4,(1+Sqrt[3])/4,-1/2},{(1-Sqrt[3])/4,(1+Sqrt[3])/4,1/2},{(-1+Sqrt[3])/4,-1/2,(-1-Sqrt[3])/4},{(-1+Sqrt[3])/4,-1/2,(1+Sqrt[3])/4},{(-1+Sqrt[3])/4,1/2,(-1-Sqrt[3])/4},{(-1+Sqrt[3])/4,1/2,(1+Sqrt[3])/4},{(-1+Sqrt[3])/4,(-1-Sqrt[3])/4,-1/2},{(-1+Sqrt[3])/4,(-1-Sqrt[3])/4,1/2},{(-1+Sqrt[3])/4,(1+Sqrt[3])/4,-1/2},{(-1+Sqrt[3])/4,(1+Sqrt[3])/4,1/2},{(1+Sqrt[3])/4,-1/2,(1-Sqrt[3])/4},{(1+Sqrt[3])/4,-1/2,(-1+Sqrt[3])/4},{(1+Sqrt[3])/4,1/2,(1-Sqrt[3])/4},{(1+Sqrt[3])/4,1/2,(-1+Sqrt[3])/4},{(1+Sqrt[3])/4,(1-Sqrt[3])/4,-1/2},{(1+Sqrt[3])/4,(1-Sqrt[3])/4,1/2},{(1+Sqrt[3])/4,(-1+Sqrt[3])/4,-1/2},{(1+Sqrt[3])/4,(-1+Sqrt[3])/4,1/2}},{{24,30,46,40},{29,45,46,30},{39,40,46,45},{23,24,40,39},{23,39,45,29},{23,29,30,24},{6,14,15,7},{10,11,15,14},{3,7,15,11},{2,6,7,3},{2,3,11,10},{2,10,14,6},{17,26,28,19},{26,42,44,28},{19,28,44,35},{17,19,35,33},{33,35,44,42},{17,33,42,26},{1,9,12,4},{9,13,16,12},{4,12,16,8},{1,4,8,5},{5,8,16,13},{1,5,13,9},{22,38,48,32},{31,32,48,47},{21,22,32,31},{21,37,38,22},{21,31,47,37},{37,47,48,38},{34,41,43,36},{25,27,43,41},{20,36,43,27},{18,34,36,20},{18,20,27,25},{18,25,41,34}}]

Graphics3D[{FaceForm[Green,Red],compound}]

PolyhedronData

PolyhedronDataString

<<MathWorld`Polyhedra`

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

PolyhedronDataString[Polyhedron[Cube6Compound,"C3"],
"StandardName"->"CubeSixCompound",
"Information"->"Cube6-Compound",
"Name"->"cube six-compound",
"AlternateStandardNames"->{"Cube6Compound"},
"AlternateNames"->{"cube 6-compound","6 cubes","six cubes"},
"Classes"->{"Compound"},
Debug->True
]

WriteString[file,PolyhedronDataString[compound,
"StandardName"->{"CubeSixCompound",2},
"AlternateStandardNames"->{},
"Name"->"second cube 6\[Hyphen]compound",
"Information"->"Cube6-Compound",
"Classes"->{"Compound"}
]]