Mathematica中的球面坐标图形

Question

是否可以在mathematica中创建像这样的球形坐标系统的图形，还是应该使用photoshop？我问，因为我想要一个高分辨率的图形，但是当放大时，互联网上的很多文件都是颗粒状的。

这是图片：

Answer 1

该图由简单的几何形状组成，这些可以使用方程在Mathematica中轻松重建。这是一个接近this情节的地方，IMO比上面的情节更简洁，但你总是可以使用这些想法来重新创建你的形象。

Clear[ellipsePhi, ellipseTheta, circle]
circle[x_] = {Cos[x], Sin[x]};
ellipsePhi[x_, a_: - Pi/2] = {Cos[x - a]/3, Sin[x + a]};
ellipseTheta[x_, a_: 0] = {Cos[x + a], Sin[-x - a]/2};
(*Main circle*)
ParametricPlot[circle[x], {x, 0, 2 Pi},
 PlotStyle -> Black,
 Epilog -> First /@ {
    (*Ellipses*)

    ParametricPlot[{ellipsePhi[x], ellipsePhi[-x], ellipseTheta[-x], 
      ellipseTheta[x]}, {x, 0, Pi},
     PlotStyle -> {{Black, Dashed}, Black}],
    (*Co-ordinate axes*)

    Graphics[
     Table[GeometricTransformation[{Arrowheads[0.03], 
        Arrow[{{0, 0}, {1.2, 0}}]}, 
       ReflectionMatrix[circle[x]]], {x, {Pi/2, -Pi/4, Pi/8}}]],
(*mark point, rho, phi & theta directions*)

ParametricPlot[{ellipsePhi[x, Pi/2], ellipseTheta[-x, 13 Pi/20]}, {x, 
   0, Pi/4},
  PlotStyle -> {{Red, Thick}, {Blue, Thick}}] /. 
 Line[x__] :> Sequence[Arrowheads[0.03], Arrow[x]],
Graphics[{{Directive[Darker@Green, Thick], Arrowheads[0.03], 
   Arrow[{{0, 0}, ellipsePhi[-3 Pi/4]}]},
  {Directive[Purple], Disk[ellipsePhi[-3 Pi/4], 0.02]}}],
(*text*)
Graphics[{
  Text[Style["x", Italic, Larger], 1.25 circle[5 Pi/4]],
  Text[Style["y", Italic, Larger], 1.25 circle[0]],
  Text[Style["z", Italic, Larger], 1.25 circle[Pi/2]],
  Text[Style["\[Rho]", Italic, Larger], 0.4 circle[4 Pi/11]],
  Text[Style["\[CurlyPhi]", Italic, Larger], 
   1.1 ellipsePhi[Pi + Pi/5]],
  Text[Style["\[Theta]", Italic, Larger], 
   1.1 ellipseTheta[13 Pi/20 - Pi/8]],
  Text[Style["P", Italic, Larger], 1.2 ellipsePhi[-3 Pi/4 + Pi/24]]}]
},
 Axes -> False, PlotRange -> 1.3 {{-1, 1}, {-1, 1}}
 ]

给你这个

虽然可以设置角度＆amp;精确地说，在某些地方（例如，13 Pi / 20），我只粗略地估计了它。你真的无法区分最终的数字，但如果你挑剔，你可以改变它们并准确地确定位置。

Answer 2

此替代解决方案具有使用3D指令创建的优势。因此，很容易将其包裹在Manipulate中，您可以用鼠标拖动它来更改视点：

Manipulate[
 Module[{x = Sin[\[Phi]] Cos[\[Theta]], y = Sin[\[Phi]] Sin[\[Theta]],
    z = Cos[\[Phi]]},
  Show[
   ParametricPlot3D[
    {{Cos[t], Sin[t], 0},
     {0, Sin[t], Cos[t]},
     {Sin[t], 0, Cos[t]}},
    {t, 0, 2 \[Pi]}, PlotStyle -> Black, Boxed -> False, 
    Axes -> False, AxesLabel -> {"x", "y", "z"}],
   ParametricPlot3D[0.5*{Cos[t], Sin[t], 0}, {t, 0, \[Theta]}],
   ParametricPlot3D[
    RotationTransform[\[Theta], {0, 0, 1}][{Sin[t]/2, 0, 
      Cos[t]/2}], {t, 0, \[Phi]}],
   Graphics3D[{
     {{Blue, Thick, 
       Arrow[{{0, 0, 0}, #}] & /@ {{1, 0, 0}, {0, 1, 0}, {0, 0, 
          1}, {x, y, z}}},
      {Opacity[0.1],
       Red, Polygon[{{0, 0, 0}, {x, y, 0}, {x, y, z}}],
       Green, Polygon[{{0, 0, 0}, {x, 0, 0}, {x, y, 0}}]}},
     {Opacity[0.05], Sphere[{0, 0, 0}]},
     {Text["O", {-.03, -.03, -.03}],
      Text["X", {1.1, 0, 0}],
      Text["Q", {x, y, 0}, {1, 1}],
      Text["P", {x, y, z}, {0, -1}],
      Text["Y", {0, 1.1, 0}],
      Text["Z", {0, 0, 1.1}],
      Text["r", {x/2, y/2, 0}, {1, 1}],
      Text[
       "\[Theta]", {Cos[\[Theta]/2]/2, Sin[\[Theta]/2]/2, 0}, {1, 
        1}],
      Text["\[Phi]", 
       RotationTransform[\[Theta], {0, 0, 1}][{Sin[\[Phi]/2]/2, 0, 
         Cos[\[Phi]/2]/2}], {1, 1}]}}]]],
 {{\[Phi], \[Pi]/4}, 0.01, \[Pi]/2}, {{\[Theta], \[Pi]/4}, 0.01, 
  2 \[Pi]}]