Study on Spherical Wedge

Question

I'm trying to create the following graphic about Spherical Coordinates:

enter image description here

I have not yet learned to set boundaries to create plans. So to show my attempts I used the Line function as an option.

Clear["Global`*"]

orig = {Red, PointSize[0.025], Point[{0, 0, 0}]};
h = 6; r = 3; x1 = 1;

First[NSolve[p1^2 + p2^2 == 6^2 && x1/r == p1/p2, {p1, p2}]] /. 
  Rule -> Set;

axisX = {Arrowheads[.075], Arrow[{{0, 0, 0}, {h + 2, 0, 0}}], 
   Text["X", {h + 2.5, 0, 0}]};
axisY = {Arrowheads[.075], Arrow[{{0, 0, 0}, {0, h + 2, 0}}], 
   Text["Y", {0, h + 2.5, 0}]};
axisZ = {Arrowheads[.075], Arrow[{{0, 0, 0}, {0, 0, h + 2}}], 
   Text["Z", {0, 0, h + 2.5}]};

pl1 = {Blue, 
   Line[{{0, 0, 0}, {0, h, 0}, {0, h, h}, {0, 0, h}, {0, 0, 0}}], 
   Text["X=0", {0, h, h}, {1.5, 1}]};
pl2 = {Brown, 
   Line[{{0, 0, 0}, {p1, p2, 0}, {p1, p2, h}, {0, 0, h}, {0, 0, 0}}], 
   Text["Y=3x", {p1, p2, h}, {1.5, 1}]};
pl3 = {Green, 
   Line[{{0, 0, 0}, {0, h, 0}, {h, h, 0}, {h, 0, 0}, {0, 0, 0}}], 
   Text["Z=0", {h, h, 0}, {0, -2}]};

lineTrac1 = {Red, Dashed, Line[{{0, r, 0}, {x1, r, 0}}], 
   Text["3", {0, r, 0}, {-2, -1}]};
lineTrac2 = {Red, Dashed, Line[{{x1, 0, 0}, {x1, r, 0}}], 
   Text["1", {x1, 0, 0}, {2, -1}]};

Graphics3D[{orig, pl1, pl2, pl3, lineTrac1, lineTrac2, axisX, axisY, 
  axisZ}, Boxed -> False, ViewPoint -> {1, 1, .5}]

Seems very amateur

With many attempts (and a weak feeling) I was able to illustrate a Spherical Wedge.

θ = ArcTan[x1/r];
arctan[x_, y_] := 
 Module[{res = ArcTan[x, y]}, If[res > 0, res, 2 π + res]]
RegionPlot3D[
 x^2 + y^2 + z^2 <= r^2 && 0 < arctan[x, y] < θ && 
  0 <= z <= r, {x, -r, r}, {y, -r, r}, {z, -r, r}, Axes -> False, 
 PlotPoints -> 50, Boxed -> False]

I would like two things:

1 - For kindness, could anyone show me what I should have done to achieve all three plans? (I know there are thousands of examples, but I swear I tried).

2 - How should I proceed to join the two graphs to form only one? (I tried using show, but I did not succeed).

another one: https://mathematica.stackexchange.com/q/111356/5478 — Kuba, Jun 24 '17 at 07:55

march · Accepted Answer · 2017-06-23T22:36:01.743

Here's a start perhaps? Using

h = 4; r = 3; x1 = 1;
Clear[p1, p2]; 
First[NSolve[p1^2 + p2^2 == 6^2 && x1/r == p1/p2, {p1, p2}]] /. Rule -> Set;

we have

pl1 = ParametricPlot3D[3 {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]},
   {u, π/2, ArcTan[9/3]}, {v, 0, π/2},
   Mesh -> None, Boxed -> False, Axes -> None, 
   PlotStyle -> {Red, Opacity[0.8], Specularity[White, 5]}];
pl2 = Graphics3D[{
    Arrow[{{0, 0, 0}, {0, 0, 5}}], Arrow[{{0, 0, 0}, {0, 5, 0}}], Arrow[{{0, 0, 0}, {5, 0, 0}}],
    Dashed,
    {Red, Line[{{1, 0, 0}, {1, 3, 0}, {0, 3, 0}}]},
    {Blue, Line[{{0, 0, 0}, {0, h, 0}, {0, h, h}, {0, 0, h}, {0, 0, 0}}], Text["X = 0", {0, h, h}, {1.5, 1}]},
    {Brown, Line[{{0, 0, 0}, {p1, p2, 0}, {p1, p2, h}, {0, 0, h}, {0, 0, 0}}], Text["Y = 3x", {p1, p2, h}, {1.5, 1}]},
    {Green, Line[{{0, 0, 0}, {0, h, 0}, {h, h, 0}, {h, 0, 0}, {0, 0, 0}}], Text["Z = 0", {h, h, 0}, {0, -2}]}
    }];
pl3 = ParametricPlot3D[
   r {Cos[ArcTan[9/3]] Sin[t], Sin[ArcTan[9/3]] Sin[t], Cos[t]},
   {r, 0, 3}, {t, 0, π/2},
   Mesh -> None, Boxed -> False, Axes -> None,
   PlotStyle -> {Red, Opacity[0.5], Specularity[White, 5]}];
pl4 = ParametricPlot3D[r {0, 3 Cos[t], 3 Sin[t]},
   {r, 0, 1}, {t, 0, π/2},
   Mesh -> None, Boxed -> False, Axes -> None,
   PlotStyle -> {Red, Opacity[0.5], Specularity[White, 5]}];

Then:

Show[pl1, pl2, pl3, pl4,
 PlotRange -> All, {ViewPoint -> {2, 2.7, 0.6}, ViewVertical -> {0.1, 0.2, 1.}}
 ]

george2079 · Answer 2 · 2017-06-23T20:42:31.050

my stab at it. Afraid the quality of the discretization is not so great.

g here is your first Graphics3D

Show[{g, RegionPlot3D[
   RegionIntersection[Ball[{0, 0, 0}, 6], 
    Parallelepiped[{0, 0, 0}, 6 {{0, 1, 0}, {1/3, 1, 0}, {0, 0, 1}}]],
    PlotPoints -> 20, PlotStyle -> Opacity[.25]]}]

this starts to look good with PlotPoints->200 , but still not remotely publication quality.

a similar approach, not as good but maybe of some use.

r = BoundaryDiscretizeRegion[
   RegionIntersection[
    Ball[{0, 0, 0}, 6], 
    Parallelepiped[{0, 0, 0}, 6 {{0, 1, 0}, {1/3, 1, 0}, {0, 0, 1}}]],
    MaxCellMeasure -> .01];
Show[{g, Graphics3D[{Opacity[.25], EdgeForm[None], 
    MeshPrimitives[r, 2]}]}]

score 0 · Answer 3 · answered Mar 28 '18 at 13:27

Using sphericalSegment[] from this answer,

Graphics3D[{{EdgeForm[], sphericalSegment[{0, 3}, {ArcTan[3], π/2}, {0, π/2}]},
            {FaceForm[], EdgeForm[Black], Hyperplane[{-1, 0, 0}, {0, 0, 0}], 
             Hyperplane[{-3, 1, 0}, {0, 0, 0}], Hyperplane[{0, 0, -1}, {0, 0, 0}]},
            {Black, Arrow[Tube[{Scaled[{0, 0, 0}, {0, 0, 0}], Scaled[#, {0, 0, 0}]}]] &
             /@ IdentityMatrix[3]}}, 
           Axes -> True, AxesLabel -> {"x", "y", "z"}, AxesOrigin -> {0, 0, 0},
           BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}},
           Boxed -> False, PlotRange -> ConstantArray[{0, 5}, 3],
           ViewPoint -> {2.4, 0., 1.}]

spherical wedge

I'm not sure why the labels for the $y$ and $z$ axes are bunched in the origin, however.

Study on Spherical Wedge

3 Answers3