How to get Geodesic Polyhedra?

Question

Does anyone have or know where to find Mathematica code to make geodesic polyhedra? I am particularly interested in ones derived from an Icosahedron. It seems this is not a ResourceFunction, or a built-in capability.

EDIT **** An example of such a polyhedra is this.

The web-page I provide above shows how that can be created by starting with an Icosahedron. I learned about this approach for approximating a sphere from this Mathematics SE question.

Answer 1

The Geodesate command will give us the polygons. For a 5-frequency geodesic dome, do this

<< PolyhedronOperations`

g = Geodesate[PolyhedronData["Icosahedron", "Faces"], 5];
Graphics3D[{Yellow, g}, Boxed -> False]

One way to extract the individual Polygons from the GraphicsComplex, $g$, is like this

Clear[poly]
poly[g_GraphicsComplex, n_ : IntegerQ] := 
  ( Polygon[g[[2, 1, n]]] /. k_Integer :> g[[1]][[k]] )
poly[g, 1] // N

(*  Polygon[{{0., 0., 1.}, {0.0609297, 0.187522, 0.980369}, {-0.159516, 
   0.115895, 0.980369}}]  *)

(A less crude method of extracting the polygons is given below.) The individual polygons can be highlighted like this

Graphics3D[{{ Opacity[1/4], Yellow, g}, {EdgeForm[{Thick, Black}], 
   Opacity[3/4], Red, Table[poly[g, k], {k, 1, 101, 25}]}}, 
 Boxed -> False]

Edit

The following code contains a better definition of poly and examples of using the new definition to obtain a single polygon and a list of polygons:

Clear[poly]
poly[g_, n_] := Part[First@Normal[g], n]

poly[g, 1] // N
Graphics3D[{{ Opacity[1/4], Yellow, g},
  {EdgeForm[{Thick, Black}], Opacity[3/4], Red,
   poly[g, {1, 26, 51, 76, 101}]}},
 Boxed -> False]

(*  results are the same as shown above  *)

Answer 2

Not too sure I fully understand.

I think the idea is filling triangular faces with smaller triangles, 6 along each edge (example used in the wiki)

So creating a 2D approximation, flattening out the icosahedron we get a net of 20 triangular faces, 10 squares in a 5x5 box

we can get the pattern in 2D

Then wrap it around a sphere (using the code from this post)

n = 5;
Table[
  Table[{{g, 0 + p}, {g, 1/6 + p}, {g + 1/6, 0 + p}}, {g, 
    0, (1 - 1/6)*n, 1/6}],
  {p, 0, 1*n, 1/6}
  ];
i0 = Show[
  Graphics[{EdgeForm[Black], {Hue[RandomReal[]], 
         Triangle[#]}}] & /@ %[[#]] & /@ Range[Length[%]]]

{width, height} = ImageDimensions[i0];
w = 40; h = 45;
pic = ImageTake[i0, {h, height - h}, {w, width - w}];
ParametricPlot3D[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}, {u, 0, 
  2 Pi}, {v, 0, Pi}, Mesh -> None, PlotPoints -> 100, 
 TextureCoordinateFunction -> ({#4, 1 - #5} &), Boxed -> False, 
 PlotStyle -> Texture[Show[i0, ImageSize -> 1000]], 
 Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", 
 ViewPoint -> {-2.026774, 2.07922, 1.73753418}, ImageSize -> 600]

You can adjust the shape for truncated icosahedron. Or are you are looking for a manipulation in 3D?

For some reason SpherePoints[] is removed from my mathematica, however

Graphics3D[Line[SpherePoints[100]]]

if you combine this and some form of ShortestPath

SpherePoints[100];
Graphics3D[Line[%[[Last[FindShortestTour[%]]]]

if you set the number of points to that of the number of points on the sphere they should be evenly spaced and the same effect.