8
$\begingroup$

how can I plot the Borromean rings in Mathematica? I am interested in the configuration showcased in figure. Three rings in linked configuration

$\endgroup$
4

1 Answer 1

11
$\begingroup$

Perhaps something you can start with:

pts = {{-3, 4.5}, {-4.5, 1}, {-4, -4.5}, {3, -4.5}, {4.5, -2}
     , {4.5, 4.5}, {-3, 3}, {5., -4}, {-4.5, -4}, {2, 2}};

Graphics3D[{
  Directive[Black, Glow[RGBColor[.9, .8, .5]]], 
    Rotate[Torus[{0, 2, 1}, {2.5, 3}], 35  Degree, {-1, 0, 0}], 
  Directive[Black, Glow[RGBColor[.9, .8, .5]]], 
    Rotate[Torus[{0, -4, 0}, {1.5, 2}], -135 Degree, {0, 1, 0}], 
  Directive[Black, Glow[RGBColor[.7, .8, .9]]], 
    Tube[BSplineCurve[{Splice@#, 0} & /@ pts, SplineDegree -> 5, SplineClosed -> True], 0.3]
  }, ViewProjection -> "Orthographic", ViewPoint -> {0, 0, 2}, 
 ViewVertical -> {1, 0, 0}, Boxed -> False]

enter image description here

$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.