# How to generate 3D spherical sector

I looked but haven't found an answer to this one: I'd like to create a region that represents a sector of a ball, bounded between radii $r_1$ and $r_2$, polar angles $\theta_1$ and $\theta_2$, and azimuthal angles $\varphi_1$ and $\varphi_2$. There seems to be no built-in functionality to achieve this directly. Do I have to assemble the region from parametric surfaces representing the spherical parts of the boundary, and trapezoids for the plane parts?

sphericalSegment[{r1_, r2_}, {θ1_, θ2_}, {ϕ1_, ϕ2_}] :=
Module[{plot, pts, surf, bdy},
plot = ParametricPlot3D[{Cos[θ] Sin[ϕ], Sin[θ] Sin[ϕ], Cos[ϕ]},
{θ, θ1, θ2}, {ϕ, ϕ1, ϕ2},
Mesh -> None, BoundaryStyle -> Black];
pts = First@Cases[plot, GraphicsComplex[p_, ___] :> p, Infinity];
surf = First@Cases[plot, Polygon[p_] :> p, Infinity];
bdy = First@Cases[plot, Line[p_] :> p, Infinity];
GraphicsComplex[
Join[r1*pts, r2*pts],
{EdgeForm[],
Polygon[surf], Polygon[Reverse /@ surf + Length@pts],
Polygon[Join[#, Reverse@# + Length@pts],
VertexNormals -> Cross[Subtract @@ pts[[#]], pts[[First@#]]]] & /@
Partition[bdy, 2, 1, 1]},
VertexNormals -> Join[-pts, pts]
]
]

Graphics3D[
sphericalSegment[{0.95, 1.1}, {0, Pi/3}, {Pi/6, Pi/2}]
] • Awesome solution, thanks! – Pirx Sep 11 '16 at 4:26
• +1, but how did you know that you had to write Reverse /@ surf rather than just surf? – C. E. Sep 11 '16 at 10:54
• @C.E. (1) I've done it many times, so I do it without thinking. Sometimes I wonder if it's always necessary, but I do it anyway. (2) Polygons have an orientation (e.g. used by FaceForm[]). Reversing the points reverses the orientation. Note the VertexNormals are reversed, too (negatives of each other). I think if r1 > r2, you'll still get a good-looking segment, but with the notions of inside/outside reversed. – Michael E2 Sep 11 '16 at 13:08
• ok, good to know. Thanks. – C. E. Sep 11 '16 at 21:20

Definition of the region:

reg := (r1^2 <= x^2 + y^2 + z^2 <= r2^2 && (* conditions on radius *)
θ1 <= ArcTan[z, Sqrt[x^2 + y^2]] <=  θ2 && (* conditions on polar angle *)
φ1 <= ArcTan[x, y] <= φ2 (* conditions on azimuthal angle *)
);


Definition of the parameters:

{r1, r2, θ1, θ2, φ1, φ2} = {2, 2.2, 30°, 180°, 15°, 85°};


Plots:

RegionPlot3D[ImplicitRegion[reg, {x, y, z}],
PlotPoints -> 80, Boxed -> False, ViewAngle -> 20°] RegionPlot3D[reg, {x, -2.5, 2.5}, {y, -2.5, 2.5}, {z, -2.5, 2.5}, Axes -> False,
PlotPoints -> 80, Boxed -> False, ViewAngle -> 20°, Mesh -> None] • Much more compact code, but RegionPlot is often somewhat "rough around the edges". I think there's a trick to get this to look better by going through DiscretizedRegion somehow. Too tired to look it up now, but that might work. Overall your code above is quite elegant, thanks! – Pirx Sep 11 '16 at 4:29
• @Pirx, you might want to see this. – J. M. will be back soon Dec 11 '16 at 3:12
• Ahah, very nice. Thanks! – Pirx Dec 11 '16 at 4:11

The NURBS representation of a spherical sector is particularly convenient, and has the advantage of not having to carry too many Polygon[] objects:

sphericalSegment[{r1_, r2_}, {θ1_, θ2_}, {φ1_, φ2_}] /; r1 < r2 :=
Module[{cknots = {0, 0, 0, 1, 1, 1}, lknots = {0, 0, 1, 1},
θa = θ2 - θ1, φa = φ2 - φ1, a1, a2, cp, cθ, cφ, p1, p2, ws, wθ, wφ},
cθ = Cos[θa/2]; cφ = Cos[φa/2];
a1 = {Cos[θ1], Sin[θ1]}; a2 = {Cos[θ2], Sin[θ2]};
p1 = {Sin[φ1] , Cos[φ1]}; p2 = {Sin[φ2], Cos[φ2]};
cp = Map[Function[pt, Append[#1 pt, #2]],
{a1, Normalize[(a1 + a2)/2]/cθ, a2}] & @@@
{p1, Normalize[(p1 + p2)/2]/cφ, p2};
ws = Outer[Times, {1, cφ, 1}, {1, cθ, 1}];
wθ = Outer[Times, {1, 1}, {1, cθ, 1}];
wφ = Outer[Times, {1, 1}, {1, cφ, 1}];
{BSplineSurface[r1 Reverse[cp, 2], SplineDegree -> 2,
SplineKnots -> {cknots, cknots}, SplineWeights -> ws],
BSplineSurface[Outer[Times, {r1, r2}, cp[], 1], SplineDegree -> {1, 2},
SplineKnots -> {lknots, cknots}, SplineWeights -> wθ],
BSplineSurface[Outer[Times, {r1, r2}, Reverse[cp[[All, 1]]], 1],
SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
SplineWeights -> wφ],
BSplineSurface[Outer[Times, {r1, r2}, cp[[All, -1]], 1],
SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
SplineWeights -> wφ],
BSplineSurface[Outer[Times, {r1, r2}, Reverse[cp[[-1]]], 1],
SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
SplineWeights -> wθ],
BSplineSurface[r2 cp, SplineDegree -> 2,
SplineKnots -> {cknots, cknots}, SplineWeights -> ws]}]


Some examples:

Graphics3D[{EdgeForm[], sphericalSegment[{9/10, 1}, {0, π/3}, {π/6, π/2}]}] Graphics3D[{EdgeForm[], sphericalSegment[{9/10, 1}, {π/3, 3 π/4}, {π/2, π}]}] • P. S. If needed, one can add BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}}, similar to what was done here. – J. M. will be back soon Dec 11 '16 at 3:24
• Can this be used to generate arbitrary spherical polygon for given vertices? (I just don't have time to investigate :)) If you want I will ask an official question. – Kuba Apr 19 '17 at 20:31
• @Kuba, no, this is only good for making spherical quadrilaterals, or isosceles spherical triangles. Making an arbitrary spherical polygon with NURBS looks tough, from what I've researched. – J. M. will be back soon Apr 20 '17 at 0:58
• Thanks. That's a pity. Does the fact that I don't care about very precise approximation changes anything? – Kuba Apr 20 '17 at 13:54
• @Kuba, you might want to look at this thread in the meantime; someday, when I find time, I'll try implementing the NURBS method for spherical polygons. – J. M. will be back soon Apr 20 '17 at 13:59