Mathematica中的球形座標圖形

Question

是否有可能在mathematica中創建像這樣的球形座標系統的圖形，還是應該使用photoshop？我在問，因爲我想要一個高分辨率的圖形，但在放大時，互聯網上的很多文件都是顆粒狀的。

這裏是圖像：

Answer 1

該圖是由簡單的幾何形狀，並且這些可以在數學使用等式容易重新創建的。這是一個接近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}} 
] 

，讓你這個

雖然可以設置角度&箭頭精確，在某些地方（例如，13π/ 20），我只能大致近似它。你真的無法分辨最終數字的差異，但如果你挑剔，你可以改變它們並精確地修正位置。

Answer 2

這種替代解決方案具有使用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]}]