Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Trying to make a better-looking globe model, I start off with something like this

enter image description here

To enhance the 3D effect, I want the lines further from the eye to be "grayer" than the lines closer to the eye, as if there were a little fog inside the sphere. I thought I might get there by replacing the great-circles with semi-transparent wafers, but it didn't work. It seems as though I hit some kind of internal limit on the number of semi-transparent objects I can create before they become opaque.

Here is the original code with polygonal great circles (minus the RGB-XYZ axes):

ClearAll[e, o, g, \[Epsilon]];
e[1] = {1, 0, 0}; e[2] = {0, 1, 0}; e[3] = {0, 0, 1};
o = {0, 0, 0}; g = 1.25; \[Epsilon] = 1/10000;
ClearAll[polycircle];
polycircle[n_: 360] := 
  Line@Table[{Cos[2 \[Pi] i/n], Sin[2 \[Pi] i/n], 0}, {i, n + 1}];
ClearAll[globeGrid];
globeGrid[bands_: 6, figure_: polycircle[]] :=
  {Table[
    Scale[Translate[figure,  Sin[(k \[Pi])/2] e[3]], 
     Cos[(k \[Pi])/2]]
    , {k, -((bands - 1)/bands), (bands - 1)/bands, 1/bands}]
   , Table[Rotate[Rotate[figure, \[Pi]/2, e[1]], k \[Pi], e[3]]
    , {k, 0, (bands - 1)/bands, 1/bands}]};
ClearAll[showFrames];
showFrames[figure_:polycircle[]] := Show[{   
   Graphics3D[{
     Opacity[0.05], Sphere[], Opacity[1.0]
     , globeGrid[6, figure]
     }]   }
  , Axes -> True
  , PlotRange -> {{-g, g}, {-g, g}, {-g, g}}
  , ImageSize -> Large];
showFrames[]

To improve it, I replace the polycircles with partially transparent wafers, which are very thin cylinders at low opacity:

ClearAll[wafer];
wafer[opacity_: 1/24] :=
  {RGBColor[1, 0.71, 0]
   , Opacity[opacity]
   , Cylinder[\[Epsilon] {-e[3], e[3]}]
   , Opacity[1]};

The results were disappointing

showFrames[wafer[]]

enter image description here

EDIT: I tried a tube

polytorus[n_: 100] := Tube[polycircle[n], 0.01];
showFrames[polytorus[48]]

it's too slow to be interactive, but it has a better 3D effect. Still looking for a better answer.

enter image description here

share|improve this question
1  
oops, my bad. should have been the constant [3]. fixed in the edit (I snipped this code from another context). –  Reb.Cabin Jul 18 at 3:05
1  
Why not just ParametricPlot3D[{Cos[lat] Cos[lon], Cos[lat] Sin[lon], Sin[lat]}, {lat, -Pi/2, Pi/2}, {lon, -Pi, Pi}, PlotStyle -> {Opacity[0.7], White}, MeshStyle -> Black]? i.stack.imgur.com/pPKE6.png –  Rahul Narain Jul 18 at 4:00
1  
@Rahul That only gives two levels of effective line color: in front or behind. I believe Reb.Cabin wants to simulate a volumetric fill. –  Mr.Wizard Jul 18 at 4:59
    
... True, but Rahul's comment is excellent. I'll wait a few days to see whether something new comes up, then ask that @Rahul promote it to an answer. –  Reb.Cabin Jul 18 at 12:53
1  
Strange. For me, showFrames[wafer[]] gives this, and showFrames[{polycircle[],waver[]}] gives this. I think the latter is what you wanted, right? BTW, I'm using version 8.0.0.0. –  celtschk Jul 18 at 12:56

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.