How can I make a simple 3D graphic as in the following image?
I know it is simply a sphere and a circle with several joining lines but I dont know how to make such simple one. I can use ParametricPlot3D
to draw the sphere $(\cos[u]\cos[v],\cos[u]\sin[v],\sin[u])$ for $-\pi\leq u,v\leq\pi$ and the circular orbit which can be taken as the intersection of the sphere with a twice radius and the plane $y+z=0$ or $x-y+z=0$. But I can not simplify the figure, i.e., making the sphere transparent so that the data can be put inside it and etc.
-
$\begingroup$ Possible duplicate: mathematica.stackexchange.com/questions/13018 $\endgroup$– Vitaliy KaurovDec 19, 2012 at 19:07
-
$\begingroup$ Related (partial solution): stackoverflow.com/q/5774073 $\endgroup$– rm -rf ♦Dec 19, 2012 at 19:13
2 Answers
Do a "Satellite" search on Demonstrations Project. You can find things like these:
The Effect of the Spherical Harmonic Gravitational Potential on Satellite Orbits, by Pradipto Ghosh
Also take a look at this post.
This is the simple figure I was looking for.
(* Parametric form of the unit sphere in 3D *)
α[t_, s_] = {Cos[s] Cos[t], Cos[s] Sin[t], Sin[s]};
(* Scale $α$ with $r$ and rotate in such a way that it is perpendicular to the vector $n$ *)
(* This will help in setting the position of the orbit of the satellite *)
β[t_, r_, n_] = r*RotationMatrix[{Cross[α[0, 0], α[π/2, 0]], n}].α[t, 0];
(* Parametric form of the orbit of the satellite *)
orbit[t_] = β[t, Sqrt[2], {1, -2, 1}];
(* The initial and the current position of the satelite*)
ip = orbit[0];
cp = orbit[π/2];
(* The projection of the current position of the satellite onto the plane $z=0$ *)
cpp = {cp[[1]], cp[[2]], 0};
(* The angle between the projection point and the $x$-axis *)
cppa = VectorAngle[cpp, {1, 0, 0}];
(* Plot in 3D*)
Show[{
ParametricPlot3D[{α[u, 0], α[π/2, u], orbit[u]}, {u, -π, π}, AxesOrigin -> {0, 0, 0}, Boxed -> False, PlotStyle -> {{Black}, {Black}, {Black}}, Ticks -> None, ViewPoint -> {2, 1, 1}, ImageSize -> 400],
Graphics3D[{{PointSize[Large], Gray, Point[ip]}, {PointSize[Large], Point[cp]}, {PointSize[Small], Point[cpp]}}],
Graphics3D[{Dashed, Line[{{0, 0, 0}, cp, cpp, {0, 0, 0}}]}],
Graphics3D[{Text[Style["x", Italic, 14], {1.5, 0, 0}], Text[Style["y", Italic, 14], {0, 1.2, 0}], Text[Style["z", Italic, 14], {0, 0, 1.5}], Text[Style["Initial position", 14], ip + {0, 0, -0.25}], Text[Style["Current position", 14], cp + {0, 0, 0.25}], Text[Style["ℓ", 16], cp/2 + {0, 0, 0.1}], Text[Style["θ", 14], {0.4*Cos[cppa/2], 0.4*Sin[cppa/2], 0}], Text[Style["ρ", 14], cpp/2 + {0.1, 0.1, 0}]}],
ParametricPlot3D[0.2*α[u, 0], {u, 0, cppa}, PlotStyle -> Directive[Dashed]]
}]
(* See for traditional axes style in 3D - http://math.stackexchange.com/a/16499/53441 *)
-
$\begingroup$ However, I have a little problem with the positioning of the image. How can I make it fit the Image box (which appears in orange color when the image is selected) with everything visible? When I click on the image and select
Trim Bounding Box
some parts become missing. $\endgroup$– bkarpuzDec 21, 2012 at 9:46 -
$\begingroup$ Using Ctrl + Drag works for cropping the output figure but it is the original size when exported. This therefore didn't work for me. $\endgroup$– bkarpuzDec 21, 2012 at 11:19
-
$\begingroup$ Crtl + Shift helps in repositioning the output figure manually, and it applies to the exported file too unlike Ctrl + Drag. $\endgroup$– bkarpuzDec 22, 2012 at 14:29
-
$\begingroup$ Use the options SphericalRegion -> True for the Show[] function if you want to get rid of the jumping. $\endgroup$– B flatDec 27, 2016 at 22:02