Drawing hollow disks in 3D with an sphere in center and small spheres on the rings
Bells and whistles. Doesn't replicate the crossings of the orbits in the artwork, but it's more consistent. Colors and lighting are a bit hard to get right.
ClearAll[orbit];
orbit // Options = {ColorFunction -> None};
orbit[OptionsPattern[]] :=
With[{cf = OptionValue[ColorFunction],
rot = ( {
{1, 0, 1/10},
{0, 1, 1/10}
} )},
Polygon[CirclePoints[1., 120].DiagonalMatrix[{0.3, 1.}].rot ->
CirclePoints[{-0.07, 0.}, 0.82,
120].DiagonalMatrix[{0.3, 1.1}].rot,
VertexColors -> (cf /. {None | Automatic -> Automatic,
f_ :> f /@ (Range[120]/120.)})]
];
paths = With[{sph = 0.85 {Cos[-0.85] + 0.05, Sin[-0.85]} {0.3, 1.1}},
Graphics3D[{
EdgeForm[{Thickness@Medium, White}]
, {orbit[ColorFunction ->
(Blend[{Hue[0.05, 1, 0.8], Darker[Yellow, 0.1]},
Cos[Pi # + Pi/4]^2] &)]}
, GeometricTransformation[
{orbit[ColorFunction ->
(Blend[{Hue[0.55, 0.9, 0.7], Darker[Cyan, 0.1]},
Cos[Pi # + Pi/4]^2] &)]},
RotationTransform[-2 Pi/3, {0, 0, 1}]
]
, GeometricTransformation[
{orbit[ColorFunction ->
(Blend[{Darker[Green, 0.4], Darker[Yellow, 0.2]},
Cos[Pi # + Pi/4]^2] &)]},
RotationTransform[2 Pi/3, {0, 0, 1}]
]
}, PlotRange -> 1, PlotRangePadding -> Scaled[.05],
ViewPoint -> Top, Boxed -> False, Lighting -> "Neutral"]
];
spheres = With[{sph = 0.85 {Cos[-0.85] + 0.05, Sin[-0.85]} {0.3, 1.1}},
Graphics[{
Inset[
Graphics3D[{Specularity[White, 5], Black, Sphere[]},
Boxed -> False, Lighting -> {{"Point", White, {0, 0, 3}}}],
Center, Center, Scaled[0.25]],
, {
{EdgeForm[White], White, Disk[sph, 0.08]},
Inset[Graphics3D[{Specularity[White, 5], Hue[0.05, 1, 0.8],
Sphere[]}, Boxed -> False,
Lighting -> {{"Point", Hue[0.1, 1, 1], {0, 0, 3}}, {"Ambient",
GrayLevel[0.6]}}],
sph, Center, Scaled[0.12]]}
, GeometricTransformation[
{
{EdgeForm[White], White, Disk[sph, 0.08]},
Inset[
Graphics3D[{Specularity[White, 5], Hue[0.55, 0.9, 0.75],
Sphere[]}, Boxed -> False,
Lighting -> {{"Point", Darker[Cyan, 0.2],
RotationTransform[2 Pi/3, {1.3, -2.4, 2}]@{0, 0,
3}}, {"Ambient", GrayLevel[0.6]}}],
sph, Center, Scaled[0.12]]},
RotationTransform[-2 Pi/3]
]
, GeometricTransformation[
{
{EdgeForm[White], White, Disk[sph, 0.08]},
Inset[
Graphics3D[{Specularity[White, 5], Darker[Green, 0.3],
Sphere[]},
Boxed -> False,
Lighting -> {{"Point", Darker[Yellow, 0.3],
RotationTransform[-2 Pi/3, {1.3, -2.4, 2}]@{0, 0,
3}}, {"Ambient", GrayLevel[0.6]}}],
sph, Center, Scaled[0.12]]},
RotationTransform[2 Pi/3]
]
}, PlotRange -> 1, PlotRangePadding -> Scaled[.05]]
];
Show[
Graphics[Inset[paths, Center, Center, Scaled[1.8]],
PlotRange -> 1, PlotRangePadding -> Scaled[.05]],
spheres]
One of many ways to get 3D hollow disks is to use Annulus[]
to specify the region in Plot3D
:
p3d = Plot3D[{x + y, x/2, -y}, {x, y} ∈ Annulus[{0, 0}, {.9, 1}],
Mesh -> None, MaxRecursion -> 5, PlotPoints -> 90,
BoundaryStyle -> Directive[Thick, Gray], Lighting -> "Neutral",
PlotStyle -> {Lighter @ Magenta, Cyan, Lighter @ Green}];
Place the spheres at random points on the centers of the orbit annuli:
boxratios = {1, 1, 3};
SeedRandom[1]
g3d = Graphics3D[{Black, Specularity[White, 10],
Scale[Sphere[{0, 0, 0}, .2], 1/boxratios],
MapThread[{#, Scale[Sphere[Append[#2 @ #3] @ #3, .12], 1/boxratios]} &,
{{Red, Blue, Green}, {Total, First[#]/2 &, -Last[#] &},
RandomPoint[Circle[{0, 0}, .95], 3]}]}];
Show[p3d, g3d , Boxed -> False, BoxRatios -> boxratios, Axes -> False,
ImageSize -> Large, Lighting -> "Neutral", ViewPoint -> {5/4, -3/4, 3},
PlotRange -> All, PlotRegion -> {{0, 1}, {-0.2, 1.3}}]
A start:
Graphics3D[
{Specularity[White, 10],
Black, Sphere[],
Red, Sphere[{1, 1, 1}, .3],
Blue, Sphere[{-1, -1, 1}, .3],
Green, Sphere[{-1, 1, 1}, .3]},
Lighting -> {{"Point", White, {3, 0, 5}}},
Boxed -> False]