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?
$\begingroup$ $\endgroup$
1 
- $\begingroup$ Possibly this?: mathematica.stackexchange.com/a/17466/4999 $\endgroup$Michael E2– Michael E22016-09-11 02:41:11 +00:00Commented Sep 11, 2016 at 2:41
Add a comment |
3 Answers
$\begingroup$ $\endgroup$
7 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}] ] 
- $\begingroup$ Awesome solution, thanks! $\endgroup$Pirx– Pirx2016-09-11 04:26:47 +00:00Commented Sep 11, 2016 at 4:26
- $\begingroup$ +1, but how did you know that you had to write
Reverse /@ surfrather than justsurf? $\endgroup$2016-09-11 10:54:49 +00:00Commented Sep 11, 2016 at 10:54 - 1$\begingroup$ @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 theVertexNormalsare reversed, too (negatives of each other). I think ifr1 > r2, you'll still get a good-looking segment, but with the notions of inside/outside reversed. $\endgroup$Michael E2– Michael E22016-09-11 13:08:04 +00:00Commented Sep 11, 2016 at 13:08 - $\begingroup$ ok, good to know. Thanks. $\endgroup$2016-09-11 21:20:10 +00:00Commented Sep 11, 2016 at 21:20
- 1$\begingroup$ @Adam Add at the end before the last
}and afterPartition[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]]]}$\endgroup$Michael E2– Michael E22020-12-03 03:43:57 +00:00Commented Dec 3, 2020 at 3:43
$\begingroup$ $\endgroup$
3 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] 
- $\begingroup$ Much more compact code, but
RegionPlotis often somewhat "rough around the edges". I think there's a trick to get this to look better by going throughDiscretizedRegionsomehow. Too tired to look it up now, but that might work. Overall your code above is quite elegant, thanks! $\endgroup$Pirx– Pirx2016-09-11 04:29:27 +00:00Commented Sep 11, 2016 at 4:29 - 2$\begingroup$ @Pirx, you might want to see this. $\endgroup$J. M.'s missing motivation– J. M.'s missing motivation2016-12-11 03:12:56 +00:00Commented Dec 11, 2016 at 3:12
- $\begingroup$ Ahah, very nice. Thanks! $\endgroup$Pirx– Pirx2016-12-11 04:11:13 +00:00Commented Dec 11, 2016 at 4:11
$\begingroup$ 
$\endgroup$
6 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, π}]}] 
answered Dec 11, 2016 at 3:11
J. M.'s missing motivation
127k11 gold badges411 silver badges590 bronze badges
- $\begingroup$ P. S. If needed, one can add
BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}}, similar to what was done here. $\endgroup$J. M.'s missing motivation– J. M.'s missing motivation2016-12-11 03:24:03 +00:00Commented Dec 11, 2016 at 3:24 - $\begingroup$ 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. $\endgroup$Kuba– Kuba2017-04-19 20:31:35 +00:00Commented Apr 19, 2017 at 20:31
- $\begingroup$ @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. $\endgroup$J. M.'s missing motivation– J. M.'s missing motivation2017-04-20 00:58:04 +00:00Commented Apr 20, 2017 at 0:58
- $\begingroup$ Thanks. That's a pity. Does the fact that I don't care about very precise approximation changes anything? $\endgroup$Kuba– Kuba2017-04-20 13:54:39 +00:00Commented Apr 20, 2017 at 13:54
- $\begingroup$ @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. $\endgroup$J. M.'s missing motivation– J. M.'s missing motivation2017-04-20 13:59:54 +00:00Commented Apr 20, 2017 at 13:59