4
$\begingroup$

Mathematica 12.0 for Windows.

Is there a buit-in way to get a surface patch of a sphere for Graphics3D?

In this Graphics3D output, the sphere is only there for backing, and I only need (and want) part of the upper hemisphere under the mesh. The 2D Circle[] function allows me to draw a segment of a circle between angles. I don't see any similar features for Sphere[] in 3D.

enter image description here

I have code that can draw smooth surface patches using parameterized functions, but the requires considerable effort, and often doesn't produce the quality that the builtin Sphere[] function produces. Here's an example.

enter image description here


Edit to add:

I went ahead and used my surface patch code to produced an approximation of what I'm looking for. It's the backing sphere that I want to trim. For example, this graphic uses a spherical cap.

enter image description here

There are defects in it, such as the divots around the rim, and there is a naval at the pole where my patches share a common vertex.

enter image description here

I'm confident that, with enough effort, I can use my patch function to draw any type of surface patch on a sphere, and remove the flaws. I was hoping for something comparable to the functionality of the 2D Circle[].

$\endgroup$
1
  • 1
    $\begingroup$ Please post the Mathematica code. $\endgroup$
    – cvgmt
    Commented Jan 29, 2023 at 0:00

2 Answers 2

4
$\begingroup$

You can also use the options MeshFunctions and RegionFunction in SphericalPlot3D to get a patch filled with mesh lines:

{θrange, ϕrange} = π {{1/6, 5/9}, {3 /2, 11/6}};

patch = SphericalPlot3D[1, θ, ϕ, 
  MeshFunctions -> {#4 &, #5 &}, 
  RegionFunction -> (And[Between[θrange]@#4, Between[ϕrange]@#5] &), 
  PlotPoints -> 100, PlotStyle -> Opacity[0], PlotRange -> 1]

enter image description here

Show[patch, Graphics3D[{Opacity[.5], Sphere[]}]]

enter image description here

$\endgroup$
3
$\begingroup$
Clear["Global`*"]

Manipulate[
 Show[
  SphericalPlot3D[1,
   {θ, θint[[1]] Degree, θint[[2]] Degree},
   {ϕ, ϕint[[1]] Degree, ϕint[[2]] Degree},
   PlotRange -> 1.05],
  Graphics3D[{Opacity[0.5], Sphere[{0, 0, 0}, 0.99],
    Darker[Red], Thick, Line[{{0, 0, 0}, #}] & /@
     Flatten[
      Table[{Cos[ϕ] Sin[θ], Sin[θ] Sin[ϕ], 
        Cos[θ]},
       {θ, θint Degree}, {ϕ, ϕint Degree}], 
      1]}],
  AxesLabel -> (Style[#, 14] & /@ {x, y, z})],
 {{θint, {50, 85}, 
   "θ interval (0—180 degrees)"},
  0, 180, 5,
  Method -> "Push",
  MinIntervalSize -> 5,
  ControlType -> IntervalSlider,
  Appearance -> "Labeled"},
 {{ϕint, {270, 330}, "ϕ interval (0—360 degrees)"},
  0, 360, 5,
  Method -> "Push",
  MinIntervalSize -> 5,
  ControlType -> IntervalSlider,
  Appearance -> "Labeled"}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.