Triangular mesh of random points on a sphere

It seems to me that the logo has three semitransparent layers of triangle meshes.

One can start with discretized sphere

reg = DiscretizeGraphics[Sphere[], MaxCellMeasure -> {"Length" -> 0.8}]

enter image description here

Or with Simon's Geodesate. Then the function for disks in 3D is helpful

disk[pos_, {nx_, ny_, nz_}, r_, n_: 16] := With[{θ = ArcTan[Sqrt[nx^2 + ny^2], nz], 
  φ = ArcTan[nx, ny]}, Polygon@Table[pos + r {Cos[α] Cos[φ] Sin[θ] - Sin[α] Sin[φ], 
        Cos[φ] Sin[α] + Cos[α] Sin[φ] Sin[θ], -Cos[α] Cos[θ]}, {α, 2. π/n, 2 π, 2. π/n}]];

Several functions to draw randomly oriented mesh on sphere, disks on vertices and opacity sphere:

mesh[m_, z_] := GeometricTransformation[{Gray, 
   Normal@GraphicsComplex[MeshCoordinates@reg, MeshCells[reg, 1]] /. 
    Line[{a_, b_}] :> Line@Table[Normalize[a t + b (1 - t)], {t, 0, 1, 0.1}]}, {First@
    QRDecomposition@m, {0, 0, z}}]
disks[m_, z_] := GeometricTransformation[{EdgeForm@Gray, 
   Glow@RGBColor[0.6, 0.75, 0.25], Black, 
   disk[#, #, 0.03] & /@ MeshCoordinates@reg}, {First@
    QRDecomposition@m, {0, 0, z}}]
sphere[op_, z_] := {Opacity@op, Glow@White, Sphere[{0, 0, z - 0.01}, 1.01]};
ball[z_] := {mesh[#, z], disks[#, z + 0.01]} &@RandomReal[NormalDistribution[], {3, 3}];

Finally, we combine three randomly oriented layers with opacity and different z-position

Graphics3D[GeometricTransformation[{sphere[1, 0], ball[0.02], sphere[0.2, 0.04],
    ball[0.06], sphere[0.2, 0.08], ball[0.10]}, 
  ScalingTransform[{0.7, 1, 1}]], Boxed -> False, ImageSize -> 300, 
 ViewPoint -> {0, 0, ∞}, ViewVertical -> {0, 1, 0}]

enter image description here

The result looks similar to the logo.


Quite long since there are arcs not lines, here is the code for them:

An efficient circular arc primitive for Graphics3D

disk = Scale[Sphere[{0, 0, 1.02}, .05], {1, 1, .2}];

Composition[
  Graphics3D[{#, [email protected], Sphere[{0, 0, 0}, 1]}, ImageSize -> 500, 
    Lighting -> "Neutral"] &
  ,
  {
   Green, GeometricTransformation[disk, RotationTransform[{{0, 0, 1}, First@#}]], 
   Gray, arc[{0, 0, 0}, #]
  } & /@ # &
  ,
  Extract[First@#, List /@ Last@#] &
  ,
  {
    Table[
     RotationMatrix[RandomReal[.7], RandomReal[1, 3]].p, {p, 
      First@#}], Composition[
      DeleteDuplicates,
      Sort /@ # &,
      Join @@ # &,
      # /. Polygon -> (Partition[{##, #}, 2, 1] & @@ # &) &
      ]@Last[#]} &
  ,
  {
    MeshCoordinates[#],
    MeshCells[#, 2]} &
  ,
  DiscretizeGraphics[#, MaxCellMeasure -> {"Length" -> 0.6}] &
  ][Sphere[]]

enter image description here


A quick hack:

With[{mesh = 
   DiscretizeGraphics@PolyhedronData["TruncatedIcosahedron", "Edges"]},
 Show[
  Graphics3D[{Opacity[1/2], Sphere[{0, 0, 0}, 0.999]}, 
   Lighting -> {{"Ambient", White}}, Boxed -> False],
  MeshPrimitives[mesh, 0] /. 
   Point[p_] :> 
    Graphics3D[{Green, EdgeForm[None], 
      MeshPrimitives[
       DiscretizeRegion@
        RegionIntersection[Sphere[], Ball[Normalize@p, 1/20]], 2]}, 
     Lighting -> {{"Ambient", White}}],
  Graphics3D[{Green, Thick, 
    MeshPrimitives[mesh, 1] /. 
     Line[{a_, b_}] :> 
      Line[Table[Normalize[t a + (1 - t) b], {t, 0, 1, 1/50}]]}]
  ]]

enter image description here

For random mesh, one could use randomly sampled points on a sphere and construct either DelaunayMesh or ConvexHullMesh from point set and use BoundaryMesh of that, but purely randomly sampled points don't actually produce aesthetic results. Thus, I use a truncated icosahedron data as an example.

EDIT

Inspired by ybeltukov, here's one with just a different mesh,

mesh = DiscretizeRegion[Sphere[], MaxCellMeasure -> {"Length" -> 0.8}]

enter image description here