A 3D Picture of a Cosmogram

By Mariam Al-Hawaj

In this program, I will present a 3D image of John Conway's Cosmogram: 
an icosahedron inscribed in an octahedron inscribed in a tetrahedron inscribed in a cube inscribed in a dodecahedron.

The trick here is to locate each of the inscribed solid in the right angle with the outer one. 
To do that, we need to figure out the exact vertices where they intersect. We will start by drawing the most outer solid “Dodecahedron”. The next solid “Cube” will then be drawn using the correct vertices from the dodecahedron. This will inscribe the cube inside the dodecahedron in the right position. Then we will continue drawing the other solids using the same methods.

____________________________________________________________________________________________________________________________________________________________________

Dodecahedron

Here we initialize "d" for dodecahedron which I will refer to quite a bit later through the program to build the solids. 
The output of "d" here is for me to understand the location of the verices of the dodecahedron as well as their order in each face. 
This is a starting point where I planned the locations of all my other solids.

d=PolyhedronData["Dodecahedron","Faces"]//N

Graphics3D[{Opacity[.1],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},Boxed->False]

Cube

Here we initialize the values for the cube verticies and polygons according to dodecahedron, making sure they have the accurate intersections.
Then we present an image of the inscribed solids.

cubev={d[[1,6]],d[[1,13]],d[[1,4]],d[[1,10]],d[[1,11]],d[[1,19]],d[[1,16]],d[[1,14]]};
cubep=PolyhedronData["Cube","FaceIndices"];
Graphics3D[{{Opacity[.1],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]}},Boxed->False]

Tetrahedron

Here we initialize the values for the tetrahedron's verticies and polygons according to dodecahedron, making sure they have the accurate intersections with the cube. 
Then we present an image of the inscribed solids.

tetrav={d[[1,10]],d[[1,16]],d[[1,19]],d[[1,6]]};
tetrap=PolyhedronData["Tetrahedron","FaceIndices"];
Graphics3D[{{Opacity[.05],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]}},Boxed->False]

Octahedron

Here we initialize the values for the octahedron's verticies and polygons according to the dodecahdron via the exact intersections to the tetrahedron. 
Then we present an image of the inscribed solids.
Notice that the verticies of the octahedron intersect the tetrahedron in points which divide the polygons of the tetrahedron into halves.

octav={(d[[1,19]]+d[[1,10]])/2,(d[[1,19]]+d[[1,6]])/2,(d[[1,19]]+d[[1,16]])/2,(d[[1,6]]+d[[1,10]])/2,(d[[1,16]]+d[[1,10]])/2,(d[[1,16]]+d[[1,6]])/2};
octap=PolyhedronData["Octahedron","FaceIndices"];
Graphics3D[{{Opacity[.05],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},{Opacity[.4],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]}},Lighting->"Neutral",Boxed->False]

Icosahedron

Here we initialize the values for the octahedron' s verticies and polygons according to the dodecahdron via the exact intersctions to the tetrahedron.
Then we present an image of the inscribed solids.
Notice that the verticies of the icosahedron intersect the octahedron in points which divide the polygons of the octahedron into golden sections. 
To find these points, we multiply the verticies of the icosahedron by (1 - golden ratio).

iv=PolyhedronData["Icosahedron","VertexCoordinates"];
icov=iv*(1-GoldenRatio)//N;
icop=PolyhedronData["Icosahedron","FaceIndices"];
Graphics3D[{{Opacity[.05],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},{Opacity[.4],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]},{Opacity[1],FaceForm[Blue],EdgeForm[Thick],EdgeForm[Blue],GraphicsComplex[icov,Polygon[icop]]}},Lighting->"Neutral",Boxed->False]

Here we present the whole image with zero opacity to get a skeleton of the cosmogram.

skeleton=Graphics3D[{{Opacity[0],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[0],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[0],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},{Opacity[0],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]},{Opacity[0],FaceForm[Blue],EdgeForm[Thick],EdgeForm[Blue],GraphicsComplex[icov,Polygon[icop]]}},Lighting->"Neutral",Boxed->False]

Manipulate

Here we manipulate the above images by creating switches from 1 to 9 and a "cosmogram" switch for all the solids of the cosmogram. Also we put a condition for "skeleton" button when clicked to show the skeleton image.

Manipulate[Pane[If[button,Show[skeleton,ImageSize->{460,460}],
Graphics3D[Switch[n,
1,{Opacity[1],FaceForm[Blue],EdgeForm[Thick],EdgeForm[Blue],GraphicsComplex[icov,Polygon[icop]]},
2,{{Opacity[1],FaceForm[Blue],EdgeForm[Thick],EdgeForm[Blue],GraphicsComplex[icov,Polygon[icop]]},{Opacity[.2],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]}},
3,{Opacity[.4],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]},
4,{{Opacity[1],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]},
{Opacity[.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]}},
5,{Opacity[.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},
6,{{Opacity[1],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},
{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]}},
7,{Opacity[.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
8,{{Opacity[1],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[.2],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d}},
9,{Opacity[.1],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},
"Cosmogram",{{Opacity[0.05],FaceForm[Red],EdgeForm[Thick],EdgeForm[Red],d},{Opacity[0.2],FaceForm[Yellow],EdgeForm[Thick],EdgeForm[Yellow],GraphicsComplex[cubev,Polygon[cubep]]},
{Opacity[0.2],FaceForm[Green],EdgeForm[Thick],EdgeForm[Green],GraphicsComplex[tetrav,Polygon[tetrap]]},{Opacity[.3],FaceForm[Cyan],EdgeForm[Thick],EdgeForm[Cyan],GraphicsComplex[octav,Polygon[octap]]},{Opacity[1],FaceForm[Blue],EdgeForm[Thick],EdgeForm[Blue],GraphicsComplex[icov,Polygon[icop]]}}],Boxed->False,PlotRange->1.4,SphericalRegion->True,ViewAngle->17Degree,ImageSize->{460,460}]],Alignment->Center],{{n,1,""},Append[Range[9],"Cosmogram"], Setter,Enabled->!button},
{{button,False,"Skeleton"},{True,False}},SaveDefinitions->True]