Group Abstract Group Abstract

Message Boards Message Boards

Decorating Easter Eggs with the Planets

The planets as Easter eggs

Just thought I'd share this fun little exercise. First, we need to get the textures to use.

textures = 
  ImageReflect[#, Right] & /@ 
   EntityValue["Planet", "CylindricalEquidistantTexture"];

Then, we need to plot parametric surfaces that look like eggs and apply the textures to them.

GraphicsGrid[Partition[With[{l = .75, a = 1, b = 1},
     ParametricPlot3D[
      Evaluate[
       RotationMatrix[
         Pi/2, {0, 1, 
          0}].{l Cos[t] + (a + b Cos[t]) Cos[t], (a + b Cos[t]) Sin[
           t] Cos[p], (a + b Cos[t]) Sin[t] Sin[p]}], {p, 0, 
       2 Pi}, {t, 0, Pi}, Mesh -> None, Boxed -> False, Axes -> False,
       Lighting -> "Neutral", PlotStyle -> Texture[#], 
      ViewPoint -> Left, PlotPoints -> 50, Background -> Black, 
      SphericalRegion -> True, ViewAngle -> Pi/6]] & /@ textures, 4], 
 Spacings -> {0, 0}, ImageSize -> 800]
POSTED BY: Jeffrey Bryant
6 Replies
Posted 7 years ago

Someone else will have to try this on my behalf for this particular application (as I do not currently have Mathematica), but whenever I wanted to experiment with textures on an egg-like surface, I tended to use Yamamoto's ovals:

tex = PlanetData["Earth", "CylindricalEquidistantTexture"];
Manipulate[RevolutionPlot3D[{(1 - h Sin[u/2]^2) Sin[u]/2, Sin[u/2]^2 + h (Sin[u]/2)^2},
                            {u, 0, ?}, Axes -> None, Boxed -> False,
                            Lighting -> "Neutral", Mesh -> None, PlotPoints -> 45,
                            PlotStyle -> Directive[Specularity[1/2, 5], Texture[tex]],
                            TextureCoordinateFunction -> ({#5, #4} &)],
            {{h, 3/5, "Distortion"}, 0, 1}, SaveDefinitions -> True]

where the setting h == 0 is the conventional sphere. I personally prefer h == 7/10, so you could do something like

With[{h = 7/10},
     Table[RevolutionPlot3D[{(1 - h Sin[u/2]^2) Sin[u]/2, Sin[u/2]^2 + h (Sin[u]/2)^2},
                            {u, 0, ?}, Axes -> None, Boxed -> False,
                            Lighting -> "Neutral", Mesh -> None, PlotPoints -> 45, 
                            PlotStyle -> Directive[Specularity[1/2, 5], Texture[tex]], 
                            TextureCoordinateFunction -> ({#5, #4} &)],
          {tex, EntityValue["Planet", "CylindricalEquidistantTexture"]}]] // (GraphicsGrid[Partition[#, 4]] &)

if you want to see the whole set of planetary eggs.

POSTED BY: J. M.
POSTED BY: Vitaliy Kaurov

Your eggs are all balanced on their pointy ends!

POSTED BY: Murray Eisenberg

Yes! It's quite easy to do in the outer space ;-)

POSTED BY: Vitaliy Kaurov

Jeff, this is really nice and funny! I was thinking about some "easter idea" myself, but in vain. Here a minor remark: The texture could still be improved using TextureCoordinateFunction -> ({#4, #3} &). My code then reads (I changed your egg function a bit):

textures = EntityValue["Planet", "CylindricalEquidistantTexture"];
GraphicsGrid[
 Partition[
  With[{l = .75, a = 1, b = 1}, 
     ParametricPlot3D[
      Evaluate[{(a + b Cos[t]) Sin[t] Cos[p], (a + b Cos[t]) Sin[
          t] Sin[p], -l Cos[t] - (a + b Cos[t]) Cos[t]}], {p, 0, 
       2 Pi}, {t, 0, Pi}, Mesh -> None, Boxed -> False, Axes -> False,
       Background -> Black, Lighting -> "Neutral", ViewPoint -> Left, 
      PlotPoints -> 50, SphericalRegion -> True, ViewAngle -> Pi/6, 
      PlotStyle -> Texture[#], 
      TextureCoordinateFunction -> ({#4, #3} &)]] & /@ textures, 4], 
 Spacings -> {0, 0}, ImageSize -> 800]

enter image description here

Regards and happy Easter! -- Henrik

POSTED BY: Henrik Schachner

enter image description here - Congratulations! This post is now featured in our Staff Pick column as distinguished by a badge on your profile of a Featured Contributor! Thank you, keep it coming!

POSTED BY: EDITORIAL BOARD
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard