6
$\begingroup$

I wish to create a nice data representation of three nested spherical sections, with a cut away so they can be viewed. As a MWE, something like;

a = SphericalPlot3D[{1}, {θ, 0, Pi}, {ϕ, 0, 4 Pi/2}, 
   PlotStyle -> Directive[Blue, Opacity[0.7], Specularity[White, 20]],
    Mesh -> None, PlotPoints -> 40];

b = SphericalPlot3D[{2}, {θ, 0, Pi}, {ϕ, 0, 3 Pi/2}, 
   PlotStyle -> Directive[Red, Opacity[0.7], Specularity[White, 20]], 
  Mesh -> {{0}, {0}, {0}}, PlotPoints -> 40];

c = SphericalPlot3D[{3}, {θ, 0, Pi}, {ϕ, 0, 3 Pi/2}, 
   PlotStyle -> 
   Directive[Green, Opacity[0.7], Specularity[White, 20]], 
  Mesh -> {{0}, {0}, {0}}, PlotPoints -> 40];

abc = Show[a, b, c, PlotRange -> Automatic]

This gives me the following image, after some rotation for clarity;

Nested spheres

This is kind of the idea, but the problem is that this displays as spherical surfaces at r = 1, r = 2 and r = 3. In reality, there is a thick spherical shell (let's say a red one) for $1 \leq r \leq 2$ and a thick spherical shell (a green one) at $2 \leq r \leq 3$. The spherical core at $r \leq 1$ is solid blue. Is there a nice way to make this image? I was hoping I could somehow modify the $r$ term in the SphericalPlot3D function to do this.

I could also like to add a vertical line running through the sphere centre (z = 0) to make the image clearer. Any ideas?

Thanks

$\endgroup$

marked as duplicate by Öskå, C. E., Mr.Wizard Aug 15 '14 at 14:55

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • $\begingroup$ Why not try using Plot3D and Filling $\endgroup$ – Jagra Aug 15 '14 at 13:16
  • $\begingroup$ Im not sure how to go about this, as AFAIR Plot3D only takes functions of 2 variables ? I suppose I could rewrite equation of sphere but seems messy.. $\endgroup$ – DRG Aug 15 '14 at 13:38
  • $\begingroup$ Related: (41985) $\endgroup$ – C. E. Aug 15 '14 at 14:14
  • $\begingroup$ Related: (14954) $\endgroup$ – Mr.Wizard Aug 15 '14 at 14:56
  • 1
    $\begingroup$ If you look below you'll see I thank Eldo for his suggestions, because I used some of his suggestions in the approach I took to fill in regions between the spheres. The data, the concepts and the rendering I had already put together, some (but not all) of which you see in the MWE. I do not think an attribution is appropriate, but thanks most certainly are! $\endgroup$ – DRG Sep 28 '14 at 17:51
10
$\begingroup$
SetOptions[{SphericalPlot3D, ParametricPlot3D}, Mesh -> None];

fun = {r {0, -Sin[t], Cos[t]}, r {Sin[t], 0, Cos[t]}};

p1 = SphericalPlot3D[{2, 2.5},
   {u, 0, Pi}, {v, 0, 1.5 Pi},
   PlotStyle -> Directive[Green, Opacity[0.7], Specularity[White, 20]]];

p2 = ParametricPlot3D[fun,
   {r, 2, 2.5}, {t, 0, Pi},
   PlotStyle -> Directive[Green, Opacity[0.7], Specularity[White, 20]]];

p3 = SphericalPlot3D[{1.5, 1.99},
   {u, 0, Pi}, {v, 0, 1.5 Pi},
   PlotStyle -> Directive[Red, Opacity[0.7], Specularity[White, 20]]];

p4 = ParametricPlot3D[fun,
   {r, 1.5, 1.99}, {t, 0, Pi},
   PlotStyle -> Directive[Red, Opacity[0.7], Specularity[White, 20]]];

p5 = SphericalPlot3D[{1, 1.48},
   {u, 0, Pi}, {v, 0, 2 Pi},
   PlotStyle -> Directive[Blue, Opacity[0.7], Specularity[White, 20]]];

Show[p1, p2, p3, p4, p5, PlotRange -> All]

enter image description here

Show[p1, p2, p3, p4, p5, PlotRange -> All, ViewPoint -> Front]

enter image description here

Edit

With the new V10 function ClipPlanes you can easily slice your graphics:

Grid[
 {{
   Show[p1, p2, p3, p4, p5, ClipPlanes -> {{-1, 1, 0, 1}}, ImageSize -> 400],
   Show[p1, p2, p3, p4, p5, ClipPlanes -> {{0, 0, -1, 0}}, ImageSize -> 400]
   }}]

enter image description here

$\endgroup$
  • $\begingroup$ @DRG Thanks for acceptance, interesting question :) $\endgroup$ – eldo Aug 15 '14 at 18:07
  • $\begingroup$ Nice use of ClipPlanes! $\endgroup$ – chris Aug 16 '14 at 13:55
  • 3
    $\begingroup$ This image (or a derivation of it) has made the cover of the first volume of Royal Society Open Science: rsos.royalsocietypublishing.org/content/1/1.cover-expansion $\endgroup$ – dr.blochwave Sep 24 '14 at 12:29
  • 1
    $\begingroup$ @blochwave Wow!, thank you! $\endgroup$ – eldo Sep 24 '14 at 13:03
  • $\begingroup$ Just spotted it! $\endgroup$ – dr.blochwave Sep 24 '14 at 13:06
6
$\begingroup$
regionsandcolors =  Thread[
   {{(x <= 0 || y >= 0) && x^2 + y^2 + z^2 < 1,
     (x <= 0 || y >= 0) &&  1 <= x^2 + y^2 + z^2 < 2,
     (x <= 0 || y >= 0) &&  2 <= x^2 + y^2 + z^2 <= 3}, {Blue, Red, Green}}]; 
plots =  RegionPlot3D[#1, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, Mesh -> None, 
       PlotStyle -> FaceForm[{Opacity[.9], #2}], 
       PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, PlotPoints -> 100, 
       MaxRecursion -> 10] & @@@ regionsandcolors;
Show[plots]

enter image description here

$\endgroup$
  • $\begingroup$ This really had me puzzled. So many simple ways that Mathematica ought to let one do this but doesn't ;-( Great solution with broad application. +1 $\endgroup$ – Jagra Aug 15 '14 at 13:55
  • $\begingroup$ @Jagra, thank you for the upvote. I agree, this seems to fall in the cracks between Mathematica's many xPlot3D functions:) $\endgroup$ – kglr Aug 15 '14 at 14:11
  • $\begingroup$ Very clever - I like this approach too. Thanks so much! $\endgroup$ – DRG Aug 15 '14 at 16:24

Not the answer you're looking for? Browse other questions tagged or ask your own question.