Drawing circular patches around arbitrary points on a sphere

I am trying to draw circular patches of given angular radii around arbitrary points on a sphere. I am able to use, for example,

SphericalPlot3D[1, {θ, 0, Pi/3}, {ϕ, 0, 2 Pi}, PlotStyle -> {Black, Opacity[0.7]},
Mesh -> None]


and

SphericalPlot3D[1, {θ, (2 Pi)/3, Pi}, {ϕ, 0, 2 Pi}, PlotStyle -> {Black, Opacity[0.7]},
Mesh -> None]


to create angular patches of (angular) radius $\pi/3$ around the north and south poles of the sphere, respectively, but what if I want to create two patches around two arbitrary points on the surface of the sphere, and then draw in the rest of the sphere in some other background color? Thank you!

Show[
SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π}, Mesh -> None,  RegionFunction ->
Function[{x, y, z, θ, ϕ, r}, Norm[{x, y, z} - {1, 1, 0}] > 1], PlotStyle -> Red],
SphericalPlot3D[1, {θ, 0, π}, {ϕ, 0, 2 π}, Mesh -> None, RegionFunction ->
Function[{x, y, z, θ, ϕ, r}, Norm[{x, y, z} - {1, 1, 0}] < 1], PlotStyle -> Blue]]


• Thank you very much! I'm still digging into the specifics of RegionFunction and its implementation in your answer, but it seems as though I can control the radius of the circular patch by changing the inequality threshold value and the point about which the patch is centered by changing the constant vector ({1,1,0} in your example). Feb 23, 2016 at 0:26
• @PhysicsCodingEnthusiast yep, that's it :) Feb 23, 2016 at 0:37
• Just for future reference (this can be added into the answer above), Norm[{x,y,z}-{x1,y1,z1}] < c defines a ball of radius c centered at (x1,y1,z1). It is, to me, easier to define the center of the ball to be on the surface of the sphere, so (x1,y1,z1) = R(sin\theta cos\phi, sin\theta sin\phi, cos\theta). Then, to get a circular patch with angular radius \gamma centered at (\theta, \phi) (or, equivalently, (x1,y1,z1)), the radius of the ball (with center (x1,y1,z1)) should be c = R \sqrt{ 2(1 - cos\gamma) }. Feb 23, 2016 at 4:00

Here is a routine that renders a spherical cap on a unit sphere as a NURBS surface:

sphericalCap[{θ_, φ_}, α_] := With[{c = Cos[α/2]},
Style[BSplineSurface[Map[RotationTransform[{{0, 0, 1},
Append[{Cos[θ], Sin[θ]} Sin[φ], Cos[φ]]}],
Map[Function[pt, Append[#1 pt, #2]],
{{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}] & @@@
{{0, 1}, {Sin[α/2]/c, 1}, {Sin[α], Cos[α]}}],
SplineClosed -> {False, True}, SplineDegree -> 2,
SplineKnots -> {{0, 0, 0, 1, 1, 1},
{0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}},
SplineWeights -> Outer[Times, {1, c, 1}, {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]],
BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 25}}]]


Examples:

Graphics3D[{Opacity[0.7, Black], sphericalCap[{0, 0}, π/6]}, Axes -> True]


BlockRandom[SeedRandom["spherecaps"];
Graphics3D[{EdgeForm[], Table[{Append[RandomColor[], 2/3],
sphericalCap[{RandomReal[{0, 2 π}], RandomReal[{0, π}]},
RandomReal[{0, π/4}]]}, {10}]}]]


Graphics3D[{Directive[EdgeForm[], GrayLevel[1/5],
Glow[Blend[{Brown, Yellow}, 1/4]], Specularity[Gray, 25]],
sphericalCap[{ArcTan @@ Most[#], ArcCos[Last[#]]},
ArcCos[(80 + 9 Sqrt[5])/109]/2] & /@
N[PolyhedronData["TruncatedIcosahedron", "VertexCoordinates"]/
Boxed -> False, Lighting -> "Neutral"]


Here's a way using MeshFunctions and MeshShading that generalized to any number of points.

pts = Normalize /@ RandomReal[{-1, 1}, {2, 3}];
angles = Table[{Pi/3}, Length@pts];
SphericalPlot3D[1, {θ, 0, Pi}, {ϕ, 0, 2 Pi},
MeshFunctions ->
Table[With[{v0 = v0},
Function[{x, y, z, θ, ϕ},
VectorAngle[{x, y, z}, v0]]], {v0, pts}],
Mesh -> angles,
MeshShading -> {{Black, Black}, {Black, Automatic}},
BoundaryStyle -> None]


More random points, random angles:

SeedRandom[7];
pts = Normalize /@ RandomReal[{-1, 1}, {3, 3}];
angles = RandomReal[0.66, {Length@pts, 1}];
ConstantArray[Black, Table[2, Length@pts]],
Table[-1, Length@pts] -> Automatic];
SphericalPlot3D[1, {θ, 0, Pi}, {ϕ, 0, 2 Pi},
PlotPoints -> 50,
MeshFunctions ->
Table[With[{v0 = v0},
Function[{x, y, z, θ, ϕ},
VectorAngle[{x, y, z}, v0]]], {v0, pts}],
Mesh -> angles,