Skip to main content
Commonmark migration
Source Link

##Edit by halirutan

Edit by halirutan

##Edit by halirutan

Edit by halirutan

added 62 characters in body
Source Link
halirutan
  • 113.4k
  • 7
  • 266
  • 479
grid = First@
   ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 
     2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None, 
    MeshStyle -> 
     Directive[Thickness[0.005], RGBColor[0, 43/255, 18/85]]];

Graphics3D[{grid, RGBColor[44/51, 10/51, 47/255], Thickness[.01], 
  Line[1.2 {{-1, 0, 0}, {1, 0, 0}}], {RGBColor[38/255, 139/255, 
    14/17], Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {RGBColor[133/255, 
    3/5, 0], Line[1.2 {{0, 0, -1}, {0, 0, 1}}]},
  White,
  Raster3D[
   Array[#3 &, {100, 100, 
     100}, {{0, 1}, {0, 1}, {0, 1}}], {{-1, -2, -2}, {1, 2, 2}}, 
   ColorFunction -> (GrayLevel[1, .05 #] &)]}, Boxed -> False]False,
  ViewPoint -> {-3.15, -0.89, 0.84}, ViewAngle -> 0.175]
grid = First@
   ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 
     2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None, 
    MeshStyle -> 
     Directive[Thickness[0.005], RGBColor[0, 43/255, 18/85]]];

Graphics3D[{grid, RGBColor[44/51, 10/51, 47/255], Thickness[.01], 
  Line[1.2 {{-1, 0, 0}, {1, 0, 0}}], {RGBColor[38/255, 139/255, 
    14/17], Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {RGBColor[133/255, 
    3/5, 0], Line[1.2 {{0, 0, -1}, {0, 0, 1}}]},
  White,
  Raster3D[
   Array[#3 &, {100, 100, 
     100}, {{0, 1}, {0, 1}, {0, 1}}], {{-1, -2, -2}, {1, 2, 2}}, 
   ColorFunction -> (GrayLevel[1, .05 #] &)]}, Boxed -> False]
grid = First@
   ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 
     2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None, 
    MeshStyle -> 
     Directive[Thickness[0.005], RGBColor[0, 43/255, 18/85]]];

Graphics3D[{grid, RGBColor[44/51, 10/51, 47/255], Thickness[.01], 
  Line[1.2 {{-1, 0, 0}, {1, 0, 0}}], {RGBColor[38/255, 139/255, 
    14/17], Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {RGBColor[133/255, 
    3/5, 0], Line[1.2 {{0, 0, -1}, {0, 0, 1}}]},
  White,
  Raster3D[
   Array[#3 &, {100, 100, 
     100}, {{0, 1}, {0, 1}, {0, 1}}], {{-1, -2, -2}, {1, 2, 2}}, 
   ColorFunction -> (GrayLevel[1, .05 #] &)]}, Boxed -> False,
  ViewPoint -> {-3.15, -0.89, 0.84}, ViewAngle -> 0.175]
added 2508 characters in body
Source Link
halirutan
  • 113.4k
  • 7
  • 266
  • 479

##Edit by halirutan

Let me point out some flaws and probably improve the quality a bit. Therefore, blame me for everything that follows, not Szabolcs.

First of all, fog is usually a global thing which means that the impact on the visibility really depends on the distance to the viewer. If the fog is only visible inside the sphere, then we have things like the top of wireframe which is crystal clear (and an eye catcher because lines meet there) while it is farther away from the camera than the front wire.

Therefore, we might improve the effect by making a foggy cube that is larger than the wireframe so that at least it looks like fog is everywhere from the camera viewpoint.

Another detail seems to be that the gradient with which view is degrading doesn't seem to be enough. Therefore, one could make a cube that has not a constant visual density, but a density that is getting larger in one direction. If we then view the wireframe from the correct viewpoint, it might increase the fog-effect.

Last point, I think fog looks better when it is white, not gray. If we combine all these points and make the wireframe thicker then I get something like the following (I'll append the code at the end):

enter image description here

There are some points left: Most importantly, I don't think it is appropriate to try to achieve something like this in the Mathematica front end. If you need high quality, then create your model and render it with Blender (or whatever renderer you prefer).

Finally, I could not get antialiasing working when I combined a Raster3D with a normal 3d graphics in Mathematica. It seems that this is not working with Raster3D or Image3D.

grid = First@
   ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 
     2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None, 
    MeshStyle -> 
     Directive[Thickness[0.005], RGBColor[0, 43/255, 18/85]]];

Graphics3D[{grid, RGBColor[44/51, 10/51, 47/255], Thickness[.01], 
  Line[1.2 {{-1, 0, 0}, {1, 0, 0}}], {RGBColor[38/255, 139/255, 
    14/17], Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {RGBColor[133/255, 
    3/5, 0], Line[1.2 {{0, 0, -1}, {0, 0, 1}}]},
  White,
  Raster3D[
   Array[#3 &, {100, 100, 
     100}, {{0, 1}, {0, 1}, {0, 1}}], {{-1, -2, -2}, {1, 2, 2}}, 
   ColorFunction -> (GrayLevel[1, .05 #] &)]}, Boxed -> False]

##Edit by halirutan

Let me point out some flaws and probably improve the quality a bit. Therefore, blame me for everything that follows, not Szabolcs.

First of all, fog is usually a global thing which means that the impact on the visibility really depends on the distance to the viewer. If the fog is only visible inside the sphere, then we have things like the top of wireframe which is crystal clear (and an eye catcher because lines meet there) while it is farther away from the camera than the front wire.

Therefore, we might improve the effect by making a foggy cube that is larger than the wireframe so that at least it looks like fog is everywhere from the camera viewpoint.

Another detail seems to be that the gradient with which view is degrading doesn't seem to be enough. Therefore, one could make a cube that has not a constant visual density, but a density that is getting larger in one direction. If we then view the wireframe from the correct viewpoint, it might increase the fog-effect.

Last point, I think fog looks better when it is white, not gray. If we combine all these points and make the wireframe thicker then I get something like the following (I'll append the code at the end):

enter image description here

There are some points left: Most importantly, I don't think it is appropriate to try to achieve something like this in the Mathematica front end. If you need high quality, then create your model and render it with Blender (or whatever renderer you prefer).

Finally, I could not get antialiasing working when I combined a Raster3D with a normal 3d graphics in Mathematica. It seems that this is not working with Raster3D or Image3D.

grid = First@
   ParametricPlot3D[{Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]}, {u, 0, 
     2 Pi}, {v, -Pi/2, Pi/2}, PlotStyle -> None, 
    MeshStyle -> 
     Directive[Thickness[0.005], RGBColor[0, 43/255, 18/85]]];

Graphics3D[{grid, RGBColor[44/51, 10/51, 47/255], Thickness[.01], 
  Line[1.2 {{-1, 0, 0}, {1, 0, 0}}], {RGBColor[38/255, 139/255, 
    14/17], Line[1.2 {{0, -1, 0}, {0, 1, 0}}]}, {RGBColor[133/255, 
    3/5, 0], Line[1.2 {{0, 0, -1}, {0, 0, 1}}]},
  White,
  Raster3D[
   Array[#3 &, {100, 100, 
     100}, {{0, 1}, {0, 1}, {0, 1}}], {{-1, -2, -2}, {1, 2, 2}}, 
   ColorFunction -> (GrayLevel[1, .05 #] &)]}, Boxed -> False]
Source Link
Szabolcs
  • 236.5k
  • 31
  • 641
  • 1.3k
Loading