5
$\begingroup$

I am trying to make a diagram for a project where there intersection of three shapes--two concentric spheres and one cone--is shaded or highlighted or in some way marked out. I currently have the following enter image description here

But the mesh caps should be rotated pi/2 so that they are centered on the x-axis and not the z-axis. The code I am using to make these caps is

cap1 = SphericalPlot3D[6, {\[Theta], Pi/4, 0}, {\[Phi], 0,  2 Pi}, 
  Boxed -> False, PlotPoints -> 50, ImageSize -> Large, 
  Boxed -> False, AxesOrigin -> {0, 0, 0},
  PlotStyle -> {Directive[Gray, Opacity[0.2]], 
    Directive[Gray, Opacity[0.1]]},  
  PlotRange -> {{-12, 12}, {-12, 12}, {-12, 12}}]

And ideally I would like to connect them with a strip that lies on the surface of the intersecting cone, but I haven't figured out how to do this yet.

And suggestions would help. I have already had a go with ContourPlot3D and RevolutionPlot3D to no avail.

Thanks.

$\endgroup$

2 Answers 2

4
$\begingroup$

SphericalPlot3D[] is not spherically symmetric. The axis $\theta=0$ is special. But I guess you could rotate your cap:

Show[
 Graphics3D[{Opacity[0.4], Sphere[{0, 0, 0}, 6]}],
 MapAt[Rotate[#, {{0, 0, 1}, {1, 0, 0}}] &, cap1, 1]
 ]

enter image description here

$\endgroup$
4
$\begingroup$
  • We can use the implicit form of the cone region x >= Tan[π/4] Sqrt[y^2 + z^2]]
cap1 = SphericalPlot3D[6, {θ, 0, Pi}, {ϕ, 0, 2 Pi}, 
  Boxed -> False, PlotPoints -> 80, MaxRecursion -> 4, 
  ImageSize -> Large, Boxed -> False, AxesOrigin -> {0, 0, 0}, 
  PlotStyle -> {Directive[Gray, Opacity[0.2]], 
    Directive[Gray, Opacity[0.1]]}, 
  PlotRange -> {{-12, 12}, {-12, 12}, {-12, 12}}, 
  RegionFunction -> 
   Function[{x, y, z, θ, φ}, 
    x >= Tan[π/4] Sqrt[y^2 + z^2] || 
     x <= -Tan[π/4] Sqrt[y^2 + z^2] || 
     z >= Tan[π/4] Sqrt[x^2 + y^2]]]

enter image description here

  • Or use ClipPlanes
cap1 = SphericalPlot3D[6, {θ, 0, Pi}, {ϕ, 0, 2 Pi}, 
   Boxed -> False, PlotPoints -> 50, ImageSize -> Large, 
   Boxed -> False, AxesOrigin -> {0, 0, 0}, 
   PlotStyle -> {Directive[Gray, Opacity[0.2]], 
     Directive[Gray, Opacity[0.1]]}, 
   PlotRange -> {{-12, 12}, {-12, 12}, {-12, 12}}];
Graphics3D[cap1[[1]], ClipPlanes -> {{1, 0, 0, -3 Sqrt[2]}}]

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.