Wolfram mathematica Mathematica中的球面坐标图形

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

图为：

---

图形由简单的几何形状组成，这些几何形状可以在Mathematica中使用方程式轻松地重新创建。这是一个接近于情节的，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}}
 ]

这给了你这个

---

虽然可以精确设置角度和箭头，但在某些地方（例如，13π/20），我只是粗略地估计了一下。你真的无法分辨最终图形的不同，但如果你很挑剔，你可以更改它们并精确地固定位置。

此替代解决方案的优点是使用3D指令创建。因此，很容易将其包裹在操纵内，您可以使用鼠标拖动操纵以更改视点：

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]}]

---

大家好，欢迎来到StackOverflow。巫师先生：你的编辑速度太快了，你能说得更具体一点吗！我以为我看到了36秒前的帖子，在我添加图片之前，你已经完成了！我完全错过了这本可能的读物。我想弄清楚他想制作什么样的球坐标图形，比如那些360°照片或环境地图。当phi==zero时出现问题。在我接受答案之前，我想试试你的代码。。。你能让它在上一版本中工作吗？你会得到什么错误？我刚刚在Mathematica 7.0.1版下成功地测试了它。顺便说一句，我已经将初始phi值更改为0.01，以避免belisarius报告的问题。