Geodesic Dome

Author

Eric W. Weisstein
June 13, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/GeodesicDome.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/GeodesicDome.html.

©2022 Wolfram Research, Inc. except for portions noted otherwise

Graphics

GeodesicPolyhedron (V13.1 built-in)

$Version

Only allows "poly" = "Tetrahedron", "Octahedron", "Icosahedron":

?GeodesicPolyhedron

GraphicsGrid[Table[Graphics3D[GeodesicPolyhedron[name,i],Boxed->False],{name,{"Tetrahedron","Octahedron","Icosahedron"}},{i,4}]]

GeodesateMesh (function repository)

https://resources.wolframcloud.com/FunctionRepository/resources/GeodesateMesh

ResourceFunction["GeodesateMesh"][#,3]&/@{Cube[],Icosahedron[],PolyhedronData["TruncatedIcosahedron","Polyhedron"]}

PolyhedronOperations.m

<<PolyhedronOperations`

?Geodesate

geodesate[g_,n_]:=If[n==0,g,Geodesate[g,n]]

V3

For a poly with coplanar points, this old code leads to overlapping polygons that can take forever to render in a complex shape.  Also, all other shapes use a triangular tesselation.  So the new code uses triangular tess.

RectGeodesateFace[face:{_,_,_,_},n_,center_,size_]:=Block[{i,j,k,vtab},vtab=Table[size Normalize[{n-i-j-k,i,j,k}.face/n-center]+center,{i,0,n},{j,0,n-i},{k,0,n-i-j}];
Flatten[Table[Polygon[{vtab[[i,j,k]],vtab[[i+1,j,k]],vtab[[i,j+1,k]],vtab[[i,j,k+1]]}],{i,n},{j,n+1-i},{k,n+2-i-j}]]~Join~Flatten[Table[Polygon[{vtab[[i,j,k]],vtab[[i-1,j,k]],vtab[[i,j-1,k]],vtab[[i,j,k-1]]}],{i,2,n+1},{j,2,n+2-i},{k,2,n+3-i-j}]]]

Show[GraphicsArray[
Table[Graphics3D[Geodesate[Polyhedron[#],n][[1]],Boxed->False]&/@polys,{n,3}]]]

V5

Show[GraphicsArray[
Table[Graphics3D[geodesate[Polyhedron[#]//N,n],Boxed->False]&/@Platonics,{n,0,3}]]]

V6

GraphicsGrid[
Table[Graphics3D[geodesate[PolyhedronData[#,"Faces"]//N,n],Boxed->False]&/@PolyhedronData["Platonic"],{n,0,3}]]

Table

ImproperForm[x_Integer]:=x
ImproperForm[x_]:=Function[{z,y},HoldForm[z+y],{HoldAll}]@@{Floor[x],x-Floor[x]}

TextGrid[{
ToLowerCase[ToString[#]],
e=Length[PolyhedronEdges[#]],
v=Length[PolyhedronVertices[#]],
e1=2e/v,
n=Length[PolyhedronFaces[#][[1]]],
ImproperForm[90 n/(e1+n)],
ImproperForm[f=180 e1/(e1+n)],
ImproperForm[n f]
}&/@Platonics,Dividers->All]

PolyhedronData

GraphicsGrid[Table[Geodesate[PolyhedronData[#]//N,n],{n,4}]&/@PolyhedronData["Platonic"]]

<<PolyhedronOperations`

<<MathWorld`PolyhedronOperations`

geodesate[pname_,n_]:=Module[{gons=Geodesate[PolyhedronData[pname],n][[1]],poly,s,verts,polys,used,newpolys,newverts},
verts=gons[[1]];
polys=gons[[2,1]];
(* discard unused interior points that are not part of any polygon; c.f. bug(413426) *)
used=Union[Flatten[polys]];
newpolys=gons[[2,1]]/.Thread[used->Range[Length[used]]];
newverts=verts[[used]];
poly=Polyhedron[newverts,newpolys];
s=Min[SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly]]]//Quiet;
Polyhedron[FullSimplify[newverts/s]//Quiet,newpolys]
]

Test Octahedron

(geo=Geodesate[PolyhedronData["Octahedron"],2][[1]])//InputForm

verts=geo[[1]];
polys=geo[[2,1]];

Graphics3D[{PointSize[.02],Point[verts],Opacity[.5],geo},Axes->True]

Graphics3D[poly=geodesate["Octahedron",2]]

PolyhedronVertices[poly]//Length

SpherePoints[18]

Graphics3D[reg=ConvexHullRegion[SpherePoints[18]]]

Norm/@PolyhedronVertices[reg]

PolyhedronEdgeLengths[reg]

Test Tetrahedron, 2

(geo=Geodesate[PolyhedronData["Tetrahedron"],2][[1]])//InputForm

verts=geo[[1]];
polys=geo[[2,1]];

Graphics3D[{PointSize[.02],Point[verts],Opacity[.5],geo},Axes->True]

MemberQ[verts,{0,0,0}]

Flatten[polys]//Union

Graphics3D[{geo[[1]]},Axes->True]

poly=geodesate["Tetrahedron",2]

poly//InputForm

SimplePolyhedronQ[poly]

Graphics3D[{PointSize[.02],Point[PolyhedronVertices[poly]],Opacity[.5],poly}]

Test Cube, 2

(geo=Geodesate[PolyhedronData["Cube"],2][[1]])//InputForm

verts=geo[[1]];
polys=geo[[2,1]];

Graphics3D[{PointSize[.02],Point[verts],Opacity[.5],geo},Axes->True]

MemberQ[geo[[1,1]],{0,0,0}]

Flatten[polys]//Union

Add

poly=geodesate["Tetrahedron",2]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly]]//Tally

MyCircumsphere[poly]//FullSimplify

sphere=Circumsphere[poly]//FullSimplify

Graphics3D[{poly,Opacity[.5],sphere}]

SimplifyNumericallyDistinct[Norm/@PolyhedronVertices[poly]]//Tally

Midsphere[poly]//Timing

Insphere[poly]//Timing

MyInsphere[poly]//Timing

Volume[poly]//FullSimplify

SurfaceArea[poly]//FullSimplify