# Draw a triangulated sphere

How to draw a triangulated sphere such as the one below in Mathematica, without being restricted to these colors, but with a more uniform color (possibly with some shaded area), and with the background frame removed?

• Which version are you in? You can get this type of deal using the region functionality pretty easily. Mar 31, 2017 at 4:27
• Use Geodesate[] from the Polyhedron Operations package (Needs["PolyhedronOperations"]), or use the region discretization functionality on a Sphere[]. Mar 31, 2017 at 4:36
• @J.M. Problem with RegionDiscretize is the coloring. It's a bit of a pain to color each cell, last I remembered. I'm currently trying it with Lighting. Mar 31, 2017 at 4:37

If you're a) on 10+ and b) don't need this cells to truly be colored, you can try this:

mesh = DiscretizeRegion@Sphere[];

MeshRegion[mesh,
Lighting -> Sequence @@@ {
ConstantArray[{"Point", Red, {0, 0, 75}}, 2],
Map[{"Point", Yellow, Append[#, 0]} &,
CirclePoints[3., 6]
],
ConstantArray[{"Point", Blue, {0, 0, -75}}, 2]
},
MeshCellHighlight -> {{1, All} -> Black}

]


This is just tricking you into thinking it's colored using Lighting. I was too lazy to highlight each cell. It's possible to write code to color an arbitrary discretized surface at the cell level. I've done it, but it's more code than I want to post here and isn't thoroughly proof-read. If you need that I can dig it up from wherever it's hiding, though.

### Update

OP mentions in the comments that he's really interested in the triangulation. That's easily extracted as such:

triangulation =
With[{cds = MeshCoordinates@mesh},
MeshCells[mesh, 2] /. i_Integer :> cds[[i]]
];


And just to check that we pulled it out right:

triangulation // Graphics3D


• Thanks, but I hope to have the "triangulated" grid for the math purpose. (Not for the art purpose.) Mar 31, 2017 at 4:44
• @wonderich Then your life is much easier. Use MeshCoordinates. I'll post an addendum. Mar 31, 2017 at 4:45
• @wonderich Added. Mar 31, 2017 at 4:49
• +1 for Lighting.BTY,MeshCellHighlight -> {{1, All} -> Black} is more similar with OP
– yode
Mar 31, 2017 at 4:49
• @MB1965 thanks for lesson on Lighting +1 :) Mar 31, 2017 at 4:50

Perhaps,

r = DiscretizeRegion[Sphere[]];
pg = MeshPrimitives[r, 2];
Graphics3D[
pg /. Polygon[
u___] :> {ColorData["Rainbow"][
Rescale[Max[u[[All, 3]]], {-1, 1}]], Polygon[u]}, Axes -> True]


:

Manipulate[
r = BoundaryDiscretizeRegion[Ball[],
MaxCellMeasure -> {"Length" -> lg}, PrecisionGoal -> 0.01];
pg = MeshPrimitives[r, 2];
Graphics3D[
pg /. Polygon[
u___] :> {ColorData["Rainbow"][
Rescale[Max[u[[All, 3]]], {-1, 1}]], Polygon[u]},
Axes -> True], {lg, {0.1, 0.5, 1, 3}}]


• @ubpdqn Ahh. Of course. Going straight to the Graphics3D is much better. Mar 31, 2017 at 4:51

## Method One

mesh = DiscretizeRegion@Sphere[];
Graphics3D[Transpose[{ColorData["Rainbow"] /@
Rescale[Last /@ PropertyValue[{mesh, 2}, MeshCellCentroid]],
MeshPrimitives[mesh, 2]}]]


## Method two(Based on this comment)

mesh = DiscretizeRegion[Sphere[]];
SliceDensityPlot3D[z, mesh, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
ColorFunction -> "Rainbow"] /. _EdgeForm -> EdgeForm[Black]


### MB1965 tweaks to Method two:

mesh = DiscretizeRegion[Sphere[],
MaxCellMeasure -> {"Length" -> .35},
PrecisionGoal -> .01];
SliceDensityPlot3D[z,
mesh, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
ColorFunction -> "Rainbow",
FaceGrids ->
-IdentityMatrix[3],
AxesEdge -> {
{-1, 1},
{1, -1},
{1, -1}
},
Boxed -> False
] /. _EdgeForm -> EdgeForm[Black]


• @MB1965 Perfect.Sorry cannot upvote. :)
– yode
Mar 31, 2017 at 7:32
• I just realized we have three different ways Mathematica can do coloring on this page. This way here clearly uses layered textures, because there are gradients in the cells. The Lighting` way does colors in the rendering system. And the way @ubpqdn did it colors individual faces. Pretty cool for such a simple question. Mar 31, 2017 at 7:35