2
$\begingroup$

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.

enter image description here

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.

Improve this question
$\endgroup$
4
  • $\begingroup$ Do you mean PolyhedronData["Icosahedron"]? $\endgroup$ Commented Jul 31, 2021 at 17:17
  • $\begingroup$ That doesn't help. I added to my question to clarify. $\endgroup$ Commented Jul 31, 2021 at 19:27
  • $\begingroup$ interesting! do you know anything more about geodesic polyhedra which could help those of us not familiar with them? for instance, is there some family of "ordinary" polyhedra they can be systematically derived from? i see that the wikipedia page suggests that some can be obtained from subdividing platonic solids and projecting to a sphere, which could be done in mathematica. Or, are you just interested in that process with the icosahedron? $\endgroup$ Commented Jul 31, 2021 at 19:36
  • $\begingroup$ All I have is what it says on the Wikepidia article for "geodesic polyhedra". In that article they take each face of an icosahedron and divide it into pieces to get more points. However, it seems to me we can get perfect equilateral triangles as follows. Start by projecting an icosahedron onto a sphere, and divide each part of the sphere into equally spaced parts. The result will be nearly the same as the approach in the Wikadedia article, but all the faces will be congruent! $\endgroup$ Commented Jul 31, 2021 at 20:51

2 Answers 2

Reset to default
1
$\begingroup$

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]

enter image description here

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]

enter image description here

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 *)
Improve this answer
$\endgroup$
0
$\begingroup$

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

enter image description here

we can get the pattern in 2D

enter image description here

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

enter image description here

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.

Improve this answer
$\endgroup$
2
  • $\begingroup$ The graphic you show, and one made using points from SpherePoints have clusters of points in a pattern near the north pole and south pole. I am looking for one with Icosahedral symmetry. That will make it look the same from 12 different directions. $\endgroup$ Commented Aug 1, 2021 at 22:43
  • $\begingroup$ @TedErsek Awh okay, I have an idea but I don't have time for a while, good luck! interesting post. $\endgroup$ Commented Aug 1, 2021 at 23:03

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.