4
$\begingroup$

I am interested to know how to make the concentric shell smoother. This is what I have now:

image

This is the code i used to generate that image:

SetOptions[{SphericalPlot3D, ParametricPlot3D}, Mesh -> None];
fun = {r {Sin[t], -Cos[t], 0}};
p1 = SphericalPlot3D[{3}, {\[Theta], 0, Pi/2}, {\[Phi], -Pi, Pi},PlotStyle -> Directive[White, Opacity[1], Specularity[]]];
p2 = SphericalPlot3D[{20, 21}, {\[Theta], 0, Pi/2}, {\[Phi], -Pi,Pi},PlotStyle -> Directive[Blue, Opacity[1], Specularity[]]];
p4 = ParametricPlot3D[fun, {r, 0, 3}, {t, 0, 2 Pi},PlotStyle -> Directive[Blue, Opacity[1], Specularity[]]];
p3 = ParametricPlot3D[fun, {r, 3, 11}, {t, 0, 2 Pi},PlotStyle -> Directive[White, Opacity[1], Specularity[]]];
p11 = ParametricPlot3D[fun, {r, 11, 14}, {t, 0, 2 Pi},PlotStyle -> Directive[Orange, Opacity[1], Specularity[]]];
p14 = ParametricPlot3D[fun, {r, 14, 16}, {t, 0, 2 Pi},PlotStyle -> Directive[Thick, Red, Opacity[1], Specularity[]]];
p16 = ParametricPlot3D[fun, {r, 16, 19}, {t, 0, 2 Pi},PlotStyle -> Directive[Yellow, Opacity[1], Specularity[]]];
p19 = ParametricPlot3D[fun, {r, 19, 21}, {t, 0, 2 Pi},PlotStyle -> Directive[Pink, Opacity[1], Specularity[]]];
Show[p1, p2, p3, p4, p11, p14, p16, p19, ViewPoint -> {-1.96178, -2.70966, -6.17715}, 
ViewVertical -> {0.326362, -0.0669218, 0.942873}, PlotRange -> All, 
ImageSize -> Large, Lighting -> "Neutral", Boxed -> False, Axes -> False, ViewPoint -> Front]
$\endgroup$
8
$\begingroup$

I think it is faster to write your own function that creates the points for the rings in 3D

disk3d[{r1_, r2_}] := With[{dphi = 2. Pi/50},
  Table[
   {
      r1 {Cos[phi], Sin[phi], 0}, 
      r2 {Cos[phi], Sin[phi], 0}, 
      r2 {Cos[phi + dphi], Sin[phi + dphi], 0}, 
      r1 {Cos[phi + dphi], Sin[phi + dphi], 0}
   }, {phi, 0, 2 Pi - dphi, dphi}]
  ]

And then you can use

p2 = SphericalPlot3D[{20, 21}, {\[Theta], 0, Pi/2}, {\[Phi], -Pi, Pi},
    PlotStyle -> Directive[Blue, Opacity[1], Specularity[]]];

Graphics3D[{EdgeForm[None], {#1, Polygon[disk3d[#2]]} & @@@ {
    {Blue, {0, 3}}, 
    {White,{3, 11}},
    {Orange, {11, 14}},
    {Red, {14, 16}},
    {Yellow, {16, 19}},
    {Pink, {19, 21}}},
    First[p2]}
]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thanks very much @halirutan. I am not much familiar with mathematica so i didn't understand the logic. I tried your solution in my machine but the image is not as much smooth as you provided in your solution. you can see output of my machine here dl.dropboxusercontent.com/u/86562049/final.png $\endgroup$ – user3704712 Sep 15 '15 at 14:51
  • 1
    $\begingroup$ This is really only the rendering (except of the mesh for the half sphere, which I don't know why it is shown in your case). Can you check your Antialiasing Quality? You find it when you go to Edit -> Preferences -> Appearance -> Graphics. Set it to highest quality and check again. $\endgroup$ – halirutan Sep 15 '15 at 15:41
5
$\begingroup$

You can set a higher number of PlotPoints to reduce the jagged look of the shells.

SetOptions[{SphericalPlot3D, ParametricPlot3D}, Mesh -> None, 
  PlotPoints -> 50];
$\endgroup$
  • $\begingroup$ Nice, but then it quits the Kernel (Mma 10.0.2.0, OSX). $\endgroup$ – mmal Sep 15 '15 at 12:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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