Wolfram Cloud Document

The regular five cube compound was first described by Edmund Hess in 1876. It is one of five regular compounds, and dual to the compound of five octahedra. It can be seen as a faceting of a regular dodecahedron. It is one of the stellations of the rhombic triacontahedron. The goal is to construct the five cube compound in an additive way, i.e. start with a single cube, then add a second, and so on. Only the parts visible are added. The benefit is that you see the intersection lines clearly. The main problem is to find the right card-boards. In this sense the five cube compound is the simplest (beside the single cube) and the three and four cube compound are the hardest. I enjoyed programming, even more so once I was done :)

Definitions

In[]:=

vertices=PolyhedronData["CubeFiveCompound","VertexCoordinates"]//N;

In[]:=

dodecahedron=Map[Polygon[vertices[[#]]]&,{{11,12,4,6,3},{6,4,10,18,20},{3,6,20,17,9},{11,3,9,7,15},{12,11,15,19,16},{4,12,16,8,10},{8,16,19,5,2},{18,10,8,2,14},{17,20,18,14,13},{7,9,17,13,1},{1,13,14,2,5},{1,5,19,15,7}}];

In[]:=

white=GrayLevel[0.99];

Single Cube in a Dodecahedron

In[]:=

Graphics3D[{EdgeForm[Gray],Opacity[0],dodecahedron,Opacity[1],Cyan,EdgeForm[{Black,Thickness[0.002]}],Map[Polygon[vertices[[#]]]&,{{19,11,4,8},{20,14,1,9},{19,1,9,11},{20,4,8,14},{19,8,14,1},{20,9,11,4}}]},Lighting->"Neutral",ViewProjection"Orthographic",BoxedFalse]

Out[]=

Remove the color:

Out[]=

Remove the shading:

Out[]=

Definitions

In[]:=

square2[{p1_,p2_,p3_,p4_}]:=With[{q=1.0/GoldenRatio},With[{qq={p1,p2,p3+q(p2-p3),p3,p4+q(p3-p4),p4}},{Polygon[qq[[{1,2,3}]]],Polygon[qq[[{3,4,5}]]],Polygon[qq[[{5,6,1}]]]}]];

Two Cubes in a Dodecahedron

Card-board with mirror image:

In[]:=

Grid[{{Graphics[square2[{{0,0},{1,0},{1,1},{0,1}}]],Graphics[square2[{{1,0},{0,0},{0,1},{1,1}}]]}}]

Out[]=

Two cubes:

In[]:=

Graphics3D[{EdgeForm[Gray],Opacity[0],dodecahedron,Opacity[1],Cyan,EdgeForm[{Black,Thickness[0.002]}],Map[square2[vertices[[#]]]&,{{19,11,4,8},{20,14,1,9},{19,1,9,11},{20,4,8,14},{19,8,14,1},{20,9,11,4}}],White,Map[square2[vertices[[#]]]&,{{19,12,3,7},{20,13,2,10},{19,2,10,12},{20,3,7,13},{19,7,13,2},{20,10,12,3}}]},Lighting->"Neutral",ViewProjection"Orthographic",BoxedFalse]

Out[]=