Anexo:

Ejemplo del programa Mathematica:

A Mathematical Construction
B. Johnston

In[1]:=
Off[General::spell,General::spell1]

In[2]:=
barycenter[Polygon[l_]] := Plus @@l/Length[l]

In[3]:=
ScalePolygon[p:Polygon[l_],r_] :=
[{b = barycenter[p]},
[(# + b)&/@(r((# - b)&/@l))]]

In[4]:=
Needs["Graphics`Polyhedra`"];

In[5]:=
Needs["Graphics`Shapes`"];

In[6]:=
SetOptions[Graphics3D,ViewPoint->{2.019, -1.837, 2.000},
Axes -> False, Boxed -> False,
LightSources->{{{1,0,1},RGBColor[0.7,0.2,0.1]},
{{1,1,1},RGBColor[0.3,0.5,0.2]},
{{0,1,1},RGBColor[0.1,0.4,0.5]}}];

In[7]:=
poly1 = OpenTruncate[Stellate[Stellate[Stellate[Stellate[
OpenTruncate[Dodecahedron[]], 0.8], 1], 1], 1], 0.2];

poly2 = OpenTruncate[Stellate[Dodecahedron[{0, 0, 0}, 1.1], 1], 0.2];

s1 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.53, 0.38, 0.85}];
s2 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.2, 0.62, 0.85}];
s3 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.65, 0.0, 0.85}];
s4 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.2, -0.62, 0.85}];
s5 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.53, -0.38, 0.85}];
s6 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.85, 0.62, 0.2}];
s7 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.32, 1.0, 0.2}];
s8 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-1.05, 0.0, 0.2}];
s9 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.33, -1.0, 0.2}];
s10 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.85, -0.62, 0.2}];
s11 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.32, 1.0, -0.2}];
s12 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.85, 0.62, -0.2}];
s13 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.85, -0.62, -0.2}];
s14 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.33, -1.0, -0.2}];
s15 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {1.05, 0.0, -0.2}];
s16 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.2, 0.62, -0.85}];
s17 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {-0.53, 0.38, -0.85}];
s18 = TranslateShape[
Graphics3D[Sphere[0.15, 24, 24]], {-0.53, -0.38, -0.85}];
s19 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.2, -0.62, -0.85}];
s20 = TranslateShape[Graphics3D[Sphere[0.15, 24, 24]], {0.65, 0.0, -0.85}];

In[29]:=
p1 = Graphics3D[ScalePolygon[#, 0.5]&/@ poly1];
p1=Graphics3D[{EdgeForm[{Thickness[0.0001],
[0]}], First[p1]}];

In[31]:=
MakePolygons[vl_List] :=
[{l = vl,
= Map[RotateLeft, vl],
},
= {
, RotateLeft[l],
[l1], l1
};
= Map[Drop[#, -1]&, me, {1}];
= Map[Drop[#, -1]&, me, {2}];
[
,
[me, {3, 1, 2}],
{2}
]
]

In[32]:=
OutlinePolygon[p:Polygon[m_], r_] :=
[
{l = m, q = ScalePolygon[p, r][[1]]},
[l, First[l]];
= Append[q, First[q]];
{EdgeForm[], MakePolygons[{l, q}],
[0.0001],GrayLevel[0],Line[l], Line[q]}
]

In[33]:=
outline1 = Graphics3D[
[#, 0.7]&/@poly1];
outline1=Graphics3D[{EdgeForm[{Thickness[0.0001],
[0]}], First[outline1]}];

outline2 = Graphics3D[
[#, 0.9]&/@poly2];
outline2=Graphics3D[{EdgeForm[{Thickness[0.0001],
[0]}], First[outline2]}];

In[37]:=
sphr = ParametricPlot3D[{0.67 Sin[v] Cos[u],
.67 Sin[v] Sin[u], 0.67 Cos[v]},
{u, 0, 2Pi}, {v, Pi/10, Pi - Pi/10},
-> {39, 20},
-> Identity];

sph = Graphics3D[{EdgeForm[], First[sphr]}];

In[39]:=
ttt=Show[{outline1, p1,outline2,sph,s1,s2,s3,s4,s5,s6,s7,
,s9,s10,s11,s12,s13,s14,s15,s16,s17,s18,s19,s20},
PlotRange->All,
DisplayFunction -> $DisplayFunction];