7
$\begingroup$

enter image description here

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.

enter image description here

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]} &)}]  

enter image description here

GraphPlot3d looks like one of Fullers creations:

enter image description here

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 ?

enter image description here

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 ?

enter image description here

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

2 Answers 2

6
$\begingroup$

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]]]@
     MapThread[Polygon@*Join]@{p1, p2}]


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

RegionUnion @@ Flatten[thickenPolygonEdges[] @ bmr]

enter image description here

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


Show[Graphics3D[{EdgeForm[], MaterialShading["Iron"], 
   thickenPolygonEdges[] @ bmr}, Lighting -> "ThreePoint", 
  Boxed -> False,  ImageSize -> Large], 
 Graphics3D[{MaterialShading[{"Glazed", Darker@Green}], 
   Sphere[{0, 0, 0}, 1.05 inradius]}]]

enter image description here

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

enter image description here

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]

enter image description here

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

enter image description here

Original answer:

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"]

enter image description here

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

Show[MeshRegion[MeshCoordinates@bmr,  
    MeshCells[bmr, 1], 
    MeshCellShapeFunction -> {1 -> ({MaterialShading["Iron"], Tube[#, .15]} &)},
    Lighting -> "ThreePoint"], 
 Graphics3D[{MaterialShading[{"Glazed", Darker @ Green}], 
   Sphere[{0, 0, 0}, 1.05 inradius]}]]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ 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. $\endgroup$
    – eldo
    Nov 13, 2023 at 7:32
7
$\begingroup$

Just an idea for Question 2:

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

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

enter image description here

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]

enter image description here

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.