Truncated Octahedron

Author

Eric W. Weisstein
January 5, 2024

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

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

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

Figure

With[{pname="TruncatedOctahedron"},
GraphicsRow[{
Graphics3D[{Opacity[.8],PolyhedronData[pname,"Polyhedron"]},Boxed->False],
Graphics3D[{PolyhedronData[pname,"Lines"]},Boxed->False],
PolyhedronData[pname,"Net"]
},ImageSize->700]]

Solid

PolyhedronData["TruncatedOctahedron","Orientations"]

PolyhedronData["TruncatedOctahedron","DefaultOrientation"]

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

Polyhedron

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

Region

PolyhedronData["TruncatedOctahedron","Region"]

Solid and Dual

GraphicsRow[PolyhedronData["TruncatedOctahedron",#]&/@{"Graphics3D","Dual","DualCompound"}]

UniformPolyhedron

uniform=UniformPolyhedron[stdname="TruncatedOctahedron"]

PolyhedronFaceTally[uniform]

UniformPolyhedron/@{
stdname,
UniformPolyhedronIndex[stdname,"Wenninger"],
{"Coxeter",UniformPolyhedronIndex[stdname,"Coxeter"]},
{"Kaleido",UniformPolyhedronIndex[stdname,"Kaleido"]},
{"Uniform",UniformPolyhedronIndex[stdname,"Maeder"]},
{"Wenninger",UniformPolyhedronIndex[stdname,"Wenninger"]}
}

SameQ@@%

Graphics3D/@(polys=Polygon[uniform[[1]],#]&/@uniform[[2]])

Graphics3D[#,Boxed->False]&/@{uniform,polys}

Bulatov

BulatovUniformName[UniformPolyhedronIndex[stdname,"Kaleido"]]

BulatovUniformGraphics3D[UniformPolyhedronIndex[stdname,"Kaleido"],Boxed->False]

bulatov=BulatovUniformPolyhedron[UniformPolyhedronIndex[stdname,"Kaleido"]]

Graphics3D/@(polys=Polygon[bulatov[[1]],#]&/@bulatov[[2]])

PolyhedronFaceTally[bulatov]

Graphics3D[#,Boxed->False]&/@{bulatov,polys}

Maeder

MaederUniformName[UniformPolyhedronIndex[stdname,"Maeder"]]

wythoff=MaederWythoffSymbol[UniformPolyhedronIndex[stdname,"Maeder"]]

Import["https://www.mathconsult.ch/static/unipoly/"<>If[maederindex<10,"0",""]<>ToString[UniformPolyhedronIndex[stdname,"Maeder"]]<>".html","Images"][[1]]

maeder=MaederUniformPolyhedron[UniformPolyhedronIndex[stdname,"Maeder"]]

Graphics3D/@(polys=Polygon[maeder[[1]],#]&/@maeder[[2]])

PolyhedronFaceTally[maeder]

Graphics3D[#,Boxed->False]&/@{maeder,polys}

Net

PolyhedronData["TruncatedOctahedron","Net"]

PolyhedronData["TruncatedOctahedron","Net","Colored"]

NetPrintout[PolyhedronData["TruncatedOctahedron","Polyhedron"],"TruncatedOctahedron.pdf"]

Properties: {"TruncatedOctahedron", "C4"} == "TruncatedOctahedron"

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["TruncatedOctahedron","Centroid"]

RegionCentroid[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce

Circumradius

PolyhedronData["TruncatedOctahedron","Circumradius"]

Circumsphere[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

MyCircumsphere[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

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

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]

EdgeLengths

PolyhedronData["TruncatedOctahedron","EdgeLengths"]

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

Inradius

PolyhedronData["TruncatedOctahedron","Inradius"]

Insphere[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

MyInsphere[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

InertiaTensor

PolyhedronData["TruncatedOctahedron","InertiaTensor"]

PolyhedronInertiaTensor[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//Timing

MomentOfInertia[PolyhedronData["TruncatedOctahedron","Polyhedron"]]/Volume[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

LogSimplify[%%]

Inetgrate over polyhedron

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

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

Divergence theorem [wrong integral]

(rxy=MeanCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxy]

ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData["TruncatedOctahedron","RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/(PolyhedronData["TruncatedOctahedron","Volume"]))

((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/(PolyhedronData["TruncatedOctahedron","Volume"]))//Timing

FullSimplify[Last[%]]

N[%]

N[(1/384) (192 (Sqrt[2]) ArcCsch[2]+81 ArcCsch[3]-2 (7 (Sqrt[2]) (-9+(Sqrt[5]))+ArcSinh[1]+81 ArcTanh[3-(Sqrt[10])]))]

TrigToExp[(1/384) (192 (Sqrt[2]) ArcCsch[2]+81 ArcCsch[3]-2 (7 (Sqrt[2]) (-9+(Sqrt[5]))+ArcSinh[1]+81 ArcTanh[3-(Sqrt[10])]))]//FullSimplify

TrigToExp[%]

N[(21/(32 (Sqrt[2])))-((7 (Sqrt[(5/2)]))/96)-(1/192) Log[1+(Sqrt[2])]+((Log[1+(Sqrt[5])]-Log[2])/(Sqrt[2]))-(27/128) (Log[(Sqrt[10])-1]-Log[10]/2)+(27/128) (Log[(Sqrt[10])+1]-Log[10]/2)]

Expand[(21/(32 (Sqrt[2])))-((7 (Sqrt[(5/2)]))/96)-(1/192) Log[1+(Sqrt[2])]+((Log[1+(Sqrt[5])]-Log[2])/(Sqrt[2]))-(27/128) (Log[(Sqrt[10])-1]-Log[10]/2)+(27/128) (Log[(Sqrt[10])+1]-Log[10]/2)]

FullSimplify[%]

TrigToExp[ArcCsch[2]]

N[%,25]

TrigToExp[ArcCoth[(Sqrt[10])]]

N[ArcCoth[(Sqrt[10])],40]

N[ArcSinh[1/3],40]

N[(1/192) (-7 (Sqrt[2]) (-9+(Sqrt[5]))+81 ArcSinh[1/3]+96 (Sqrt[2]) Log[GoldenRatio]-ArcSinh[1])]

FullSimplify[(1/192) (-7 (Sqrt[2]) (-9+(Sqrt[5]))+81 ArcSinh[1/3]+96 (Sqrt[2]) Log[GoldenRatio]-ArcSinh[1])]

N[(1/192) ((Sqrt[2]) (63-7 (Sqrt[5])+96 Log[GoldenRatio])+81 ArcCsch[3]-ArcSinh[1])]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

((Integrate[(x^2)+(y^2),{x,y,z}∈PolyhedronData[{"TruncatedOctahedron",#},"Polyhedron"]])/vol)&/@PolyhedronData["TruncatedOctahedron","Orientations"]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["TruncatedOctahedron","Polyhedron"]])/vol)

Integrate over polyhedron

((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈PolyhedronData["TruncatedOctahedron","Polyhedron"]])/vol)//Timing

CAD [unevaluated]

cad=CylindricalDecomposition[PolyhedronData["TruncatedOctahedron","RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

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

CAD over  1/8 [wrong result]

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/4]x]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//FullSimplify

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

8((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=8((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=LogSimplify[rxy]//FullSimplify

Divergence theorem [unevaluated integral]

(rxyz=MeanSphericalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈PolyhedronData[{"TruncatedOctahedron",#},"Polyhedron"]])/vol)&/@PolyhedronData["TruncatedOctahedron","Orientations"]

Midradius

PolyhedronData["TruncatedOctahedron","Midradius"]

Midsphere[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

Surface Area

PolyhedronData["TruncatedOctahedron","SurfaceArea"]

RootReduce[%]

SurfaceArea[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//RootReduce//Timing

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

Volume

PolyhedronData["TruncatedOctahedron","Volume"]

Volume[PolyhedronData["TruncatedOctahedron","Polyhedron"]]//FullSimplify

PolyhedronVolume[PolyhedronData["TruncatedOctahedron","Polyhedron"],Method->"GaussLaw"]//FullSimplify

Properties: {"TruncatedOctahedron", "C4xy"}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"TruncatedOctahedron","C4xy"},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

adj1=PolyhedronData[pname,"AdjacentFaceIndices"]

adj2=AdjacentFaceIndices[p]

adj1===adj2

Centroid

PolyhedronData[pname,"Centroid"]

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

RegionCentroid[p]

PolyhedronCentroid[p]

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

Circumsphere[p]

MyCircumsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

(sphere=MyCircumsphere[p])//Timing

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

Classes

PolyhedronData[pname,"Classes"]

Compound

PolyhedronData[pname,"Compound"]

CompoundInterior

Interior

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]

Style[Graphics3D[{{Opacity[.1],p},Red,interior},Boxed->False],RenderingOptions->{"3DRenderingMethod"->"BSPTree"}]

MyCircumsphere[interior]//Quiet

Insphere[interior]/.x_?NumericQ:>RootReduce[x]//Quiet//Timing

Midsphere[interior//N]

Construction

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

Graphics3D[int]

Graphics3D[{{Opacity[.1],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 when all intersections are computable

polygons=PolyhedronData[pname,"Polygons"]

Length@polygons

Binomial[%,3]

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

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

pts[[1]]

bug(440813): RegionIntersection[plane1, plane2, plane3] returns Point with hidden zero in denominator for planes that don't intersect in a point

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->.4]

vexact=pts4

Plane intersections numerically

Length[polygons=PolyhedronData[pname,"Polygons"]]

Binomial[%,3]

Length[nintersections=ThreePlaneIntersection/@Subsets[N[polygons,20],{3}]]//Timing

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

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

Length[pos=Position[nintersections,Point[x_]/;normineqs[groupednorms][x]]//Flatten]//Quiet//Timing

Length[intersections=ThreePlaneIntersection/@Subsets[polygons,{3}][[pos]]]//Timing

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

Style[Graphics3D[{AbsolutePointSize[5],Point[N[pts]],Opacity[.2],p}],RenderingOptions->{"3DRenderingMethod"->"BSPTree"}]

Length[pts2=DeleteDuplicates[Map[ToAlgebraicRoot[#,"RootReduce"->False]&,pts,{2}]]]//Quiet//Timing

Length[grouped]

Graphics3D[{AbsolutePointSize[5],Point[pts2],{Opacity[0],p},Red,ConvexHullRegion[pts2]}]

Union[pts2]//Length

Length[polyhedra=PolyhedronData[pname,"Polyhedra"]]

inside=Select[pts2,AllTrue[polyhedra,Function[poly,RegionMember[poly,#]]]&]

Length[inside]

outside=Complement[pts2,inside]

SimplifyNumericallyDistinct[Norm/@inside,"Simplification"->RootReduce]//Union

SimplifyNumericallyDistinct[Norm/@outside,"Simplification"->RootReduce]//Union

Style[Graphics3D[{{Opacity[.2],int},AbsolutePointSize[5],Point[inside],Red,Point[outside]},Boxed->False],RenderingOptions->{"3DRenderingMethod"->"BSPTree"}]

hull=ConvexHullRegion[inside]

Graphics3D[{{Opacity[.5],hull},Point[inside]}]

vexact=inside

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

lengths=Keys[%]

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

PolyhedronData["TetrakisHexahedron","EdgeLengths"]

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

pname

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}

Find rotation matrix

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

Graphics3D[{{Opacity[.5],LabelPolyhedron[p,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv=s rot.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

rot=RotationMatrix[{basev[[4]],Mean@p[[1]][[{3,7}]]}]//FullSimplify

rot2=RotationMatrix[θ,Subtract@@newv[[{4,3}]]]

newv2=rot2.#&/@newv;

p1[[1]][{3,6,7}]

Solve[RegionDistance[InfinitePlane[p1[[1]][[{3,6,7}]]],newv2[[5]]]==0&&0<θ<π,θ]//FullSimplify

rottotal=FullSimplify[rot2/.θ->((5 π)/12)].rot//FullSimplify

Graphics3D[{{Opacity[.5],LabelPolyhedron[p1,Background->LightGreen]},
LabelPolyhedron@Polyhedron[newv2=s rottotal.#&/@basesolid[[1]],basesolid[[2]]]},Boxed->False]

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[%,RenderingOptions->{"3DRenderingMethod"->"BSPTree"}]

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

PolyhedronInertiaTensor[p]//Timing

Insphere

sphere=PolyhedronData[pname,"Insphere"]

Insphere[p]

MyInsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

sphere=MyInsphere[p]

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

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

ClosestMeanCylindricalRadius[%]

Integrate over polyhedron

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

N[rxy]

Divergence theorem

(rxy=MeanCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/16

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/4]x&&z>0]

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//FullSimplify

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

16((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=16((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy]

ByteCount[rxylog=LogSimplify[rxy,"ZeroTestNumericalPrecision"->10000,WorkingPrecision->10000,Debug->True]]//Timing

ByteCount[rxycollect=Collect[TrigToExp[rxylog],Log[_]]//RootReduce]//Timing

rxycollect

rxycollect//FullSimplify//Expand

N[%]

MeanInteriorLineSegmentLength

lbar=PolyhedronData[pname,"MeanInteriorLineSegmentLength"]

N[%]

GlobalAdaptive numerical integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

(1/(vol^2)) NIntegrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[ineq[x1,y1,z1]&&ineq[x2,y2,z2]],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax},
Method->{"GlobalAdaptive","MaxErrorIncreases"->1*^4}]//Timing

Integration

ineq=PolyhedronData[pname,"RegionFunction"]

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=RegionBounds[ImplicitRegion[ineq[x,y,z],{x,y,z}]]

cad=CylindricalDecomposition[ineq[x1,y1,z1]&&ineq[x2,y2,z2],{x1,y1,z1,x2,y2,z2},"Function"]

(1/(vol^2)) Integrate[Sqrt[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]Boole[cad],
{x1,xmin,xmax},{y1,ymin,ymax},{z1,zmin,zmax},
{x2,xmin,xmax},{y2,ymin,ymax},{z2,zmin,zmax}]

Monte Carlo

reg=PolyhedronData[pname,"Region"]

Length[lines=Partition[RandomPoint[N@reg,10^7],2]]//Timing

Graphics3D[{{Opacity[.2],EdgeForm[],BoundaryDiscretizeRegion[reg]},Red,Line/@Take[lines,UpTo@1000]},AspectRatio->Automatic]

lengths=Norm/@Subtract@@@lines;//Timing

Histogram[lengths,{.01}]

Mean[lengths]

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

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

N[rxyz]

Divergence theorem

(rxyz=MeanSphericalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxyz]

LogSimplify[rxyz]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD over  1/XX

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/5]x]

Show[Graphics3D[{Opacity[.2],p}],RegionPlot3D[ImplicitRegion[reg,{x,y,z}],PlotPoints->50]]

((Volume[ImplicitRegion[reg,{x,y,z}]])/vol)//FullSimplify

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

XX((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=XX((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

ByteCount[rxyzlog=LogSimplify[rxyz,"ZeroTestNumericalPrecision"->10000,WorkingPrecision->10000,Debug->True]]//Timing

ByteCount[rxyzcollect=Collect[TrigToExp[rxyzlog],Log[_]]//RootReduce]//Timing

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

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

Integrate over Polyhedron

(rxy2=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Divergence theorem

(rxy2=MeanSquareCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

Integrate over polyhedron

(rxy2=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)//FullSimplify)

N[rxy2]

Integrate over region

reg=PolyhedronData[pname,"RegionFunction"][x,y,z]

(rxy=((Integrate[((x^2)+(y^2)+(z^2))Boole[reg],{x,y,z}∈FullRegion[3]])/vol))

Divergence theorem

(rxy2=MeanSquareSphericalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}==CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq]((x^2)+(y^2)+(z^2)),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

Midsphere[N[p,50]]

%/.x_?InexactNumberQ:>FullSimplify@RootApproximant[x]

(sphere=Midsphere[p])//Timing

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

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

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//Timing

PolyhedronData[pname,"SurfaceArea"]

poly3d=PolyhedronData[pname,"Net","Polygons"]/.Polygon[v_]:>Polygon[Append[#,0]&/@v]

Total[Area/@Flatten[poly3d]]//RootReduce//FullSimplify

Graphics3D[{FaceForm[Green,Red],poly3d},Axes->True,AxesLabel->{"x","y","z"}]

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

{RegionPlot3D[ImplicitRegion[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z}]],
Graphics3D[p]}

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

ineq=FullSimplify[%]

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

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,Cases[Union[emb,{pname}],Alternatives@@PolyhedronData[All]]}}}

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

RenameGraphFiles[]

pname

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

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

Faces

PolyhedronFaceList[poly]

Show[GraphicsArray[partition[PolyhedronFaces[poly],5]]]

Square Faces

f1=v[[{8,14,16,10}]];
f2=v[[{9,15,17,11}]];

Show[GraphicsArray[{
Graphics3D[{
Polygon[f1],LabelVertices[f1]
},Boxed->False],
Graphics3D[{
Polygon[f2],LabelVertices[f2]
},Boxed->False],
Graphics3D[{
Polygon[f1],LabelVertices[f1],
Polygon[f2],LabelVertices[f2],
Line[{Centroid[f1][[1]],Centroid[f2][[1]]}]
},Boxed->False]
}]]

{a,b}=FullSimplify[{Centroid[f1][[1]],Centroid[f2][[1]]}]

Together//@FullSimplify[Sqrt[(a-b).(a-b)]]

Hexagonal Faces

f1=v[[{4,7,13,20,15,9}]];
f2=v[[{16,10,5,12,18,21}]];

Show[GraphicsArray[{
Graphics3D[{
Polygon[f1],LabelVertices[f1]
},Boxed->False],
Graphics3D[{
Polygon[f2],LabelVertices[f2]
},Boxed->False],
Graphics3D[{
Polygon[f1],LabelVertices[f1],
Polygon[f2],LabelVertices[f2],
Line[{Centroid[f1][[1]],Centroid[f2][[1]]}]
},Boxed->False]
}]]

{a,b}=FullSimplify[{Centroid[f1][[1]],Centroid[f2][[1]]}]

Together//@FullSimplify[Sqrt[(a-b).(a-b)]]

Dihedral angles

Show[Graphics3D[{poly,
MapIndexed[Text[#2[[1]],#1]&,Centroid/@poly//N]
}],Boxed->False]

{4,6}

Show[Graphics3D[p=poly[[{1,8}]]],Boxed->False]

π-RootReduce/@(DihedralAngle@@p)

InputForm[%]

N[%]180/Pi

{6,6}

Show[Graphics3D[p=poly[[{8,11}]]],Boxed->False]

RootReduce[π-DihedralAngle@@p]

InputForm[%]

N[%]180/Pi

Projections

PolyhedronProjectionGraph[PolyhedronData["TruncatedOctahedron","Polyhedron"],#]&/@{{0,1,0},{1,1,0},{0,(Sqrt[2]),1},{0,1,1},{1,3,0},{0,1,2 (Sqrt[2])},{1,1,1,π/6+π/2},{1,2,0}}

GraphData["TruncatedOctahedralGraph","Graph","Perspective"]

Vertex subset hulls

Platonic

VertexSubsetHulls[PolyhedronData["TruncatedOctahedron","Polyhedron"],"Platonic","Icosahedra"->True]//Timing

Construction

C4

TruncatedOctahedronExact:=TruncatedOctahedronExact=Module[{sq3=Sqrt[2]},OrientCentered[{Polygon[{{1,-1,2sq3},{-1,-1,2sq3},{-1,1,2sq3},{1,1,2sq3}}/2],Polygon[{{1,-1,-2sq3},{-1,-1,-2sq3},{-1,1,-2sq3},{1,1,-2sq3}}/2],Polygon[{{2,2,sq3},{3,1,0},{2,2,-sq3},{1,3,0}}/2],Polygon[{{-2,2,sq3},{-3,1,0},{-2,2,-sq3},{-1,3,0}}/2],Polygon[{{2,-2,sq3},{3,-1,0},{2,-2,-sq3},{1,-3,0}}/2],Polygon[{{-2,-2,sq3},{-3,-1,0},{-2,-2,-sq3},{-1,-3,0}}/2],Polygon[{{1,-1,-2sq3},{-1,-1,-2sq3},{-2,-2,-sq3},{-1,-3,0},{1,-3,0},{2,-2,-sq3}}/2],Polygon[{{1,-1,2sq3},{-1,-1,2sq3},{-2,-2,sq3},{-1,-3,0},{1,-3,0},{2,-2,sq3}}/2],Polygon[{{1,1,-2sq3},{-1,1,-2sq3},{-2,2,-sq3},{-1,3,0},{1,3,0},{2,2,-sq3}}/2],Polygon[{{1,1,2sq3},{-1,1,2sq3},{-2,2,sq3},{-1,3,0},{1,3,0},{2,2,sq3}}/2],Polygon[{{1,-1,2sq3},{1,1,2sq3},{2,2,sq3},{3,1,0},{3,-1,0},{2,-2,sq3}}/2],Polygon[{{1,-1,-2sq3},{1,1,-2sq3},{2,2,-sq3},{3,1,0},{3,-1,0},{2,-2,-sq3}}/2],Polygon[{{-1,-1,2sq3},{-1,1,2sq3},{-2,2,sq3},{-3,1,0},{-3,-1,0},{-2,-2,sq3}}/2],Polygon[{{-1,-1,-2sq3},{-1,1,-2sq3},{-2,2,-sq3},{-3,1,0},{-3,-1,0},{-2,-2,-sq3}}/2]}]]

C4xy

Show[PolyhedronData[{"TruncatedOctahedron","C4"}],Axes->True,AxesLabel->{"x","y","z"}]

v=RotationMatrix[π/4,{0,0,1}].#&/@PolyhedronData[{"TruncatedOctahedron","C4"},"Vertices"]

p=Polyhedron[v,PolyhedronData["TruncatedOctahedron","FaceIndices"]]

<<MathWorld`PolyhedronOperations`

PolyhedronInequalities[p,{#1,#2,#3}]//FullSimplify