# 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
Commented Sep 11, 2016 at 4:26
• +1, but how did you know that you had to write Reverse /@ surf rather than just surf? Commented Sep 11, 2016 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. Commented Sep 11, 2016 at 13:08
• ok, good to know. Thanks. Commented Sep 11, 2016 at 21:20
• @Adam Add at the end before the last } and after Partition[bdy, 2, 1, 1]: {Black, Thick, Line[bdy], Line[bdy + Length@pts], Line[Transpose@{#, # + Length@pts} &@Flatten@Nearest[pts -> "Index", Flatten[Table[{Cos[θ] Sin[ϕ], Sin[θ] Sin[ϕ], Cos[ϕ]}, {θ, {θ1, θ2}}, {ϕ, {ϕ1, ϕ2}}], 1]]]} Commented Dec 3, 2020 at 3:43

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
Commented Sep 11, 2016 at 4:29
• @Pirx, you might want to see this. Commented Dec 11, 2016 at 3:12
• Ahah, very nice. Thanks!
– Pirx
Commented Dec 11, 2016 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]], 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. Commented Dec 11, 2016 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
Commented Apr 19, 2017 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. Commented Apr 20, 2017 at 0:58
• Thanks. That's a pity. Does the fact that I don't care about very precise approximation changes anything?
– Kuba
Commented Apr 20, 2017 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. Commented Apr 20, 2017 at 13:59