Chamfered Cube

Author

Eric W. Weisstein
October 6, 2022

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

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

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

Graphic

PolyhedronData["*ChamferedCube"]

Varying chamfering ratios

With[{p=Cube[]},GraphicsRow[Graphics3D[{Opacity[.8],#},Boxed->False]&/@Prepend[Table[ResourceFunction["ChamferedPolyhedron"][p,r],{r,.2,.99,.2}],p]]]

Solid

Graphics3D[{Opacity[.8],PolyhedronData["EquilateralChamferedCube","Polyhedron"]},Boxed->False]

Graphics3D[{FaceForm[Green,Red],PolyhedronData["EquilateralChamferedCube","Polyhedron"]},Boxed->False]

Net

PolyhedronData["EquilateralChamferedCube","Net"]

PolyhedronData["EquilateralChamferedCube","Net","Colored"]

Properties

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar=RegionCentroid[poly]//FullSimplify)//Timing

PolyhedronCentroid[poly]//FullSimplify//Quiet//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[poly]//Timing

MyCircumsphere[poly]//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly]]//Quiet//Union

PolyhedronEdgeLengths[poly]//RootReduce//Union//Quiet//Timing

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[poly]//FullSimplify//Quiet

RootReduce[%]

FullSimplify[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

(ii=Map[ToAlgebraicRoot,i,{2}])//Quiet//Timing

iii=RootReduce[(ii/vol)]//FullSimplify

N[iii]

Equal@@Tr[iii,List]

(i=PolyhedronInertiaTensor[poly,vol])//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[poly]//Timing

MyInsphere[poly]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

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

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

Divergence theorem

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

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)

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

Inequalities

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

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

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

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

(ii1=FullSimplify[i1])//Timing

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

N[i2]

(ii2=RootReduce[i2])//Timing

(iii2=FullSimplify[i2])//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate

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

Divergence theorem

(rxy=MeanSphericalRadius[p,Debug->True])//Timing

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)

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

Integrate over z first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[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"]

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

MeanSquareCylindricalRadius[p]//FullSimplify//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+(z^2),{x,y,z}∈poly])/vol)//FullSimplify)//Timing

MeanSquareSphericalRadius[p]//FullSimplify//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[poly]//Timing

Midsphere[poly,Method->"PointLineDistance","SolveMethod"->"NSolve"]//Timing

Net

PolyhedronData[pname,"Net"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

ineq=Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[poly,{x,y,z}]

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

FullSimplify/@%

FullSimplify@%

Skeleton

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

PolyhedronData[pname,"Skeleton"]

SurfaceArea

SurfaceArea[poly]//ToAlgebraicRoot//FullSimplify//Quiet//Timing

PolyhedronSurfaceArea[poly]//RootReduce//FullSimplify//Timing

Volume

PolyhedronData[pname,"Volume"]

Volume[poly]//RootReduce//Timing

Volume[poly]//RootReduce//FullSimplify

PolyhedronVolume[poly]//ToAlgebraicRoot//Quiet//Timing

Volume[PolyhedronData[pname,"Region"]]//RootReduce//Timing

Volume[PolyhedronData[pname,"Region"]]//ToAlgebraicRoot//Timing

Construction

Mangaldan

from Jan Mangaldan, July 2022

EquilateralChamferedCube=Polyhedron[];

Weisstein

f[p_,r_?NumericQ]:=Module[{e=PolyhedronEdgeLengths[ChamferedPolyhedron[p,r]]},Divide@@MinMax[e]]

data=Table[{r,f[Cube[],r]},{r,.1,.9,.01}]

ListPlot[data]

peakpos=FindPeaks[data[[All,2]]]

peaks=data[[peakpos[[All,1]]]]

ListLinePlot[
{data,peaks},
Joined->{True,False},
PlotStyle->{Automatic,PointSize[.03]}
]

({r}=FindArgMax[f[Cube[],r],{r,8/10,82/100},WorkingPrecision->100])//Timing

rexact=ToAlgebraicRoot[N[r,50]]

Graphics3D[p=ChamferedPolyhedron[Cube[],rexact]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]]//Union//Quiet

Net construction

Graphics3D[{Opacity[.8],PolyhedronData["EquilateralChamferedCube","Polyhedron"]},Boxed->False]

PolyhedronEdgeLengths[PolyhedronData["EquilateralChamferedCube","Polyhedron"]]//FullSimplify//Union

Graphics3D[{{Opacity[.8],PolyhedronData["EquilateralChamferedCube","Polyhedron"]},MapIndexed[Text[#2[[1]],#,Background->White]&,v=PolyhedronData["EquilateralChamferedCube","Vertices"]]},Boxed->False]

α=VectorAngle[v[[7]]-v[[16]],v[[13]]-v[[16]]]//FullSimplify

β=VectorAngle[v[[16]]-v[[7]],v[[18]]-v[[7]]]//FullSimplify

FullSimplify[4α+2β]

h=EuclideanDistance@@v[[{9,13}]]//FullSimplify

h//N

l=EuclideanDistance@@v[[{6,8}]]//FullSimplify

PolyhedronData["EquilateralChamferedCube","FaceCountRules"]

v

v=Flatten[Table[{(h+1) x,0}+#&/@Tuples[{-1,1}/2,2],{x,-1,2}],1];
v=Join[v,{v[[2]]-{h,0},v[[1]]-{h,0}}];
v=Join[v,Sequence@@Table[{(1+h)/2+(h+1)x,y l/2},{y,-1,1,2},{x,-2,1}]];
v=Join[v,{v[[6]]+{0,h},v[[8]]+{0,h},v[[5]]-{0,h},v[[7]]-{0,h}}];
v=Join[v,{v[[6]]+{-(l-1),h}/2,v[[8]]+{(l-1),h}/2,v[[5]]+{-(l-1),-h}/2,v[[7]]+{(l-1),-h}/2}];
v=Join[v,{v[[29]]-{0,1},v[[30]]-{0,1},v[[27]]+{0,1},v[[28]]+{0,1}}];
v=Join[v,Table[v[[31]]+{x(h+1),0},{x,{-1,1,2}}],Table[v[[32]]+{x(h+1),0},{x,{-1,1,2}}]];
v=Join[v,Table[v[[33]]+{x(h+1),0},{x,{-1,1,2}}],Table[v[[34]]+{x(h+1),0},{x,{-1,1,2}}]];
v=Join[v,(v[[#]]+{0,h})&/@{2,4,10,12,14,16}];
v=Join[v,(v[[#]]+{0,-h})&/@{1,3,9,11,13,15}];
f=Sort@{{3,4,2,1},{7,8,6,5},{12,10,9,11},{16,14,13,15},{2,23,17,18,19,1},{6,24,4,3,20,5},{10,25,8,7,21,9},{14,26,12,11,22,13},{27,31,6,8,32,28},{7,5,33,29,30,34},{30,29,35,36},{28,38,37,27},{42,52,51,39,2,4},{43,54,53,40,10,12},{44,56,55,41,14,16},{3,1,45,57,58,48},{11,9,46,59,60,49},{15,13,47,61,62,50}};
Graphics[{FaceForm[LightYellow],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

Area[Polygon[v,f]]//FullSimplify

PolyhedronData["EquilateralChamferedCube","SurfaceArea"]

Sort@f

FullSimplify[v]

GraphData

GraphDataString

<<MathWorld`Graphs`

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

WriteString[file,PolyhedronDataString[EquilateralChamferedCube,
"StandardName"->"EquilateralChamferedCube",
"Name"->"equilateral chamfered cube",
"AlternateStandardNames"->{}
]]