3
$\begingroup$

It is a follow-up question from this one.

I'll put the code at the end. So far, I have:enter image description here

Notice how nearer $z$ is to $0$, the more transparent the sphere is. I don't want to plot the whole hemisphere, but even if I make the domain for $u$ smaller, I don't get what I want, and I think the problem is because the other Plot3D there. Also, I am sure there is an intelligent way of getting the same figure here with less coding, using two Plot3D doesn't feel right, but it's the only way I can make it now.

  • How can I plot less of the hemisphere?
  • How can I optimize this mess?

(As a sidenote, it bothers me very much the fact that the figure "stretches" a bit, everytime I rotate it to have a better view.. what I am using AspectRatio -> 1 and BoxRatios -> {1,1,1} for, then? Neither works.)

Thank you.

 Show[ParametricPlot3D[{Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}, {u, 
       0, \[Pi] - .5}, {v, 0, 2 \[Pi]}, Mesh -> Automatic, 
      MeshStyle -> 
       Directive[GrayLevel[0], Opacity[0.04`], AbsoluteThickness[0.`], 
        DotDashed], 
      PlotStyle -> 
       Directive[RGBColor[0.9500000000000001`, 1.`, 0.64`], 
        Opacity[0.1`]]], 
     Plot3D[Sqrt[1 - x^2 - y^2], {x, -.8, .8}, {y, -.8, .8}, 
      Mesh -> Automatic, 
      MeshStyle -> 
       Directive[RGBColor[0.51`, 0.51`, 0.51`], AbsoluteThickness[0.`], 
        Dashing[{0, Small, Small, Small}]], 
      PlotStyle -> RGBColor[0.6`, 0.6`, 0.6`], 
      RegionFunction -> 
       Function[{x, y, z, u, 
         v}, (x - Cos[\[Pi]/4] Cos[\[Pi]/3 - \[Pi]/2])^2 + (y - 
            Cos[\[Pi]/4] Sin[\[Pi]/3 - \[Pi]/2])^2 + (z - 
            Sin[\[Pi]/4])^2 <= 1/30]], 
     Plot3D[Sqrt[1 - x^2 - y^2], {x, -.8, .8}, {y, -.8, .8}, 
      PlotStyle -> RGBColor[0.6`, 0.6`, 0.6`], Mesh -> Automatic, 
      MeshStyle -> 
       Directive[RGBColor[0.51`, 0.51`, 0.51`], AbsoluteThickness[0.`], 
        Dashing[{0, Small, Small, Small}]], 
      RegionFunction -> 
       Function[{x, y, z, u, 
         v}, (x - Cos[\[Pi]/4] Cos[\[Pi]/3 - \[Pi]/2 - 0.3`])^2 + (y - 
            Cos[\[Pi]/4] Sin[\[Pi]/3 - \[Pi]/2 - 0.3`])^2 + (z - 
            Sin[\[Pi]/4])^2 <= 1/30]], 
     Graphics3D[{PointSize[Large], Blue, 
       Point[{Cos[\[Pi]/4] Cos[(\[Pi]/3) - (\[Pi]/2) - .15], 
         Cos[\[Pi]/4] Sin[(\[Pi]/3) - (\[Pi]/2) - .15], Sin[\[Pi]/4]}]}], 
     AspectRatio -> 1, AxesOrigin -> {0, 0, 0}, Boxed -> False]
$\endgroup$
5
  • 1
    $\begingroup$ Something like SphericalPlot3D[.99, {u, 0, \[Pi]/2}, {v, 6 Pi/4, Pi 2}, Mesh -> None, SphericalRegion -> True, RotationAction -> "Clip"] instead your first plot does what you need? $\endgroup$
    – Kuba
    Mar 1, 2015 at 22:18
  • $\begingroup$ You mean instead of the first ParametricPlot3D ? $\endgroup$
    – Ivo Terek
    Mar 1, 2015 at 22:20
  • $\begingroup$ Yes (9 characters to go) $\endgroup$
    – Kuba
    Mar 1, 2015 at 22:21
  • $\begingroup$ Or use SphericalRegion -> True, ImageSize -> 400 (with some fixed ImageSize to your liking. $\endgroup$
    – Jens
    Mar 1, 2015 at 22:22
  • $\begingroup$ @Kuba, after messing a bit more with your suggestion, I got something nice here, thanks. I read about SphericalRegion here and I understood that this function is what "fixed" the zoom. Is that right? (I'm a bit slow with softwares and english is not my first language, sorry) $\endgroup$
    – Ivo Terek
    Mar 1, 2015 at 22:32

1 Answer 1

2
$\begingroup$

Maybe this?

c0 = Directive[RGBColor[0.9500000000000001`, 1.`, 0.64`], 
   Opacity[0.5`]];
{c1, c12, c2} = {RGBColor[0.6`, 0.6`, 0.6`], 
   RGBColor[0.6`, 0.6`, 0.6`], RGBColor[0.6`, 0.6`, 0.6`]};
Show[
 ParametricPlot3D[{Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]},
  {u, 0, π/2}, {v, 0, 2 π},
  PlotPoints -> 50, Mesh -> {{1/30}, {1/30}}, 
  MeshStyle -> 
   Directive[GrayLevel[0], Opacity[0.4`], AbsoluteThickness[0.`]], 
  MeshFunctions -> {Function[{x, y, z, u, 
      v}, (x - Cos[π/4] Cos[π/3 - π/2])^2 + (y - 
         Cos[π/4] Sin[π/3 - π/2])^2 + (z - 
         Sin[π/4])^2], 
    Function[{x, y, z, u, 
      v}, (x - Cos[π/4] Cos[π/3 - π/2 - 0.3`])^2 + (y - 
         Cos[π/4] Sin[π/3 - π/2 - 0.3`])^2 + (z - 
         Sin[π/4])^2]},
  RegionFunction -> 
   Function[{x, y, z, u, v}, 
    EuclideanDistance[{x, y, 
       z}, {Cos[π/4] Cos[(π/3) - (π/2) - .15], 
       Cos[π/4] Sin[(π/3) - (π/2) - .15], Sin[π/4]}] <
      0.5],
  MeshShading -> {{c12, c2}, {c1, c0}}],
 ParametricPlot3D[{Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}, {u, 
   0, π}, {v, 0, 2 π}, 
  MeshStyle -> 
   Directive[RGBColor[0.51`, 0.51`, 0.51`], AbsoluteThickness[0.`], 
    Dashing[{0, Small, Small, Small}]],
  RegionFunction -> 
   Function[{x, y, z, u, v}, 
    EuclideanDistance[{x, y, 
       z}, {Cos[π/4] Cos[(π/3) - (π/2) - .15], 
       Cos[π/4] Sin[(π/3) - (π/2) - .15], Sin[π/4]}] <
      0.5],
  PlotStyle -> None], 
 Graphics3D[{PointSize[Large], Blue, 
   Point[{Cos[π/4] Cos[(π/3) - (π/2) - .15], 
     Cos[π/4] Sin[(π/3) - (π/2) - .15], Sin[π/4]}]}], 
 AspectRatio -> 1, AxesOrigin -> {0, 0, 0}, Boxed -> False, 
 SphericalRegion -> True, PlotRange -> {{0, 1}, {-1, 0.1}, {0, 1}}]

Mathematica graphics

$\endgroup$
7
  • $\begingroup$ Exporting the graphics causes the dashed line to disappear. Isn't there a workaround on this site somewhere? $\endgroup$
    – Michael E2
    Mar 1, 2015 at 22:30
  • $\begingroup$ Thanks Michael, you're a life saver haha Don't worry about the dashed lines, I pasted your code here and they show up all right. This works nice, too. I'm wondering how you got the part of the sphere to be plotted to be so... circular. Got to study what you have done, now. $\endgroup$
    – Ivo Terek
    Mar 1, 2015 at 22:35
  • 1
    $\begingroup$ @IvoTerek I used a RegionFunction that used the EuclideanDistance from the blue point. If you'd like a different shape, change the RegionFunction. -- Yeah, the dashed lines show up in Mma, but apparently not if you print it, export to PDF, etc. $\endgroup$
    – Michael E2
    Mar 1, 2015 at 22:38
  • $\begingroup$ Oh, I see. I just didn't got one thing. When you used the MeshFunctions, we have the ugly expressions involving sine and cosine, however, how do Mathematica knows that it's supposed to mesh the "inside" of these disks, and not "outside"? I mean, we dont have any ` <= 1/10 ` like in the other question you helped me with. I don't know if I expressed myself good enough here, sorry.. $\endgroup$
    – Ivo Terek
    Mar 1, 2015 at 22:45
  • 1
    $\begingroup$ The option Mesh specifies values $m$ etc. for the mesh lines, which are curves of the form $f=m$ for a mesh function $f$. The plot "starts" in the "lower left corner" of the plot domain, in your case u == 0, v == 0. As u and v increase, the plot crosses a mesh line. The plot changes its mesh shading according to the MeshShading array: if it crosses the first mesh function, it changes row; if it crosses the second mesh function, it changes column. $\endgroup$
    – Michael E2
    Mar 1, 2015 at 22:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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