# Construction of a Fuller dome

Cover of TIME magazine, January 10, 1964

Richard Buckminster Fuller (1895 - 1983) was an American architect and designer. He popularized the Geodesic Dome. Carbon molecules are also known as Fullerenes for their mathematical resemblance to geodesic spheres.

Buckminster Fuller (Mid) and Josef Albers (left) with students at Black Mountain College, summer 1948: Construction of a geodesic dome.

We can visualize geodesic structures with PolyhedronData or, as Syed commented, with GeodesicPolyhedron:

GraphicsRow[{
PolyhedronData["PentagonalHexecontahedron", "Skeleton", "Rule"] // GraphPlot3D,
PolyhedronData["PentagonalHexecontahedron", "Faces", "Graphics3D"],
PolyhedronData["PentagonalHexecontahedron", "Edges", "Graphics3D"] /.
Line -> ({MaterialShading["Iron"], Tube[#, 0.1]} &)}]


GraphPlot3d looks like one of Fullers creations:

Question 1:

Can we produce a structure with steel bands instead of tubes (like in the 2nd photo from above)? With other words: Can we cut out the polygon faces similar to kglr's answer of this question: Jeeners Flower ?

Question 2

Can we combine faces and tubified edges similar to this structure, which I produced by exporting faces and edges of the PentagonalHexecontahedron to Blender ?

• For reference: the GeodesicPolyhedron doc page.
– Syed
Nov 12, 2023 at 9:51
• Thanks, Syed, very interesting, I didn't know that
– eldo
Nov 12, 2023 at 9:55

Update: For Q1:

ClearAll[thickenPolygonEdges]

thickenPolygonEdges[width_ : .3, thickness_ : .05][bmesh_] :=
MeshPrimitives[bmesh, 2] /.
Polygon[x_] :>
Module[{c = Mean@x, p1 = Partition[x, 2, 1, {1, 1}], p2},
p2 = Map[Reverse]@
Partition[Map[(c + (1 - width) (# - c)) &, x], 2, 1, {1, 1}];
ReplaceAll[Polygon[y_] :>
ConvexHullMesh[Join[y, (1 + thickness) y]]]@

bmr = PolyhedronData["PentagonalHexecontahedron", "BoundaryMeshRegion"];

RegionUnion @@ Flatten[thickenPolygonEdges[] @ bmr]


inradius = PolyhedronData["PentagonalHexecontahedron", "Inradius"];

thickenPolygonEdges[] @ bmr}, Lighting -> "ThreePoint",
Boxed -> False,  ImageSize -> Large],


Replace Sphere[...] with MeshPrimitives[bmr, 2] to get

Not sure if the following is needed but could be useful to play with:

ClearAll[subdivideFaces]

subdivideFaces[centerheight_ : 1.05][bmesh_] :=
Module[{mc = MeshCoordinates@bmesh,
mcc = centerheight AnnotationValue[{bmesh, 2}, MeshCellCentroid],
faceindices = MeshCells[bmesh, 2][[All, 1]]},
BoundaryMeshRegion[Join[mc, mcc],
MapIndexed[
Map[Polygon]@
Map[Append[Length[mc] + #2[[1]]]]@
Partition[#, 2, 1, {1, 1}] &] @ faceindices]]

subdivideFaces[][bmr]


Show[Graphics3D[{EdgeForm[], MaterialShading[{"Glazed", Gray}],
thickenPolygonEdges[]@subdivideFaces[][bmr]},
Lighting -> "ThreePoint", Boxed -> False, ImageSize -> Large],


For Q2:

bmr = PolyhedronData["PentagonalHexecontahedron", "BoundaryMeshRegion"];

MeshRegion[MeshCoordinates@bmr,
MeshCells[bmr, 1 | 2],
MeshCellShapeFunction ->
{1 -> ({MaterialShading["Iron"], Tube[#, .15]} &),
2 -> ({MaterialShading[{"Glazed", Darker@Green}], Polygon@#} &)},
Lighting -> "ThreePoint"]


inradius = PolyhedronData["PentagonalHexecontahedron", "Inradius"];

Show[MeshRegion[MeshCoordinates@bmr,
MeshCells[bmr, 1],
MeshCellShapeFunction -> {1 -> ({MaterialShading["Iron"], Tube[#, .15]} &)},
Lighting -> "ThreePoint"],


• Thank you , certainly much more than I hoped for. Maybe you should change the definition sequence: The second image from above only shows after evaluating thickenPolygonEdges and inradius. Could be confusing for an occasional user.
– eldo
Nov 13, 2023 at 7:32

Just an idea for Question 2:

chm = ConvexHullMesh@Point[PolyhedronData["PentagonalHexecontahedron", "VertexCoordinates"]];

Show[
, Lighting -> {"ThreePoint"}, Boxed -> False]
, MeshPrimitives[chm, 1] /.
Line[{a_, b_}] :> Tube[Table[Normalize[t a + (1 - t) b], {t, 0, 1, 1/50}], .025]}]
, ImageSize -> Small]


Update for Question 1 (still with tubes instead of steel bands)

bdr = BoundaryMeshRegion[GeodesicPolyhedron["Icosahedron", 3]];
pts = Sequence @@@ MeshPrimitives[bdr, 0];
lines = Sequence @@@ MeshPrimitives[bdr, 1];
centroids = Select[pts, Length@Counts[Round[#, .01] & /@
EuclideanDistance @@@ Cases[lines, l_ /; ContainsAny[l, {#}]]] == 1 &];
nearest[centroid_] := Line[{centroid, #}] & /@ NearestTo[centroid, 7][centroids]

Show[
Graphics3D[{LightGreen, Opacity[.7], Sphere[]},
Lighting -> {"Accent"}, Boxed -> False]
, Graphics3D[{Directive[LightGray]
, MeshPrimitives[bdr, 1] /. Line[{a_, b_}] :>
Tube[Table[Normalize[t a + (1 - t) b], {t, 0, 1, 1/50}], .020]
}]
, Graphics3D[{Directive[LightGray]
, (nearest /@ centroids) /. Line[{a_, b_}] :>
Tube[Table[Normalize[t a + (1 - t) b], {t, 0, 1, 1/50}], .018]
}], ImageSize -> Medium]


• Thank you, vindobona, an excellent solution!
– eldo
Nov 12, 2023 at 17:25
• @eldo You're welcome! :-) Nov 12, 2023 at 18:32