bez[pts_] := Module[{allpts, fs}, allpts = Join[pts, pts]; fs = (Interpolation[#, InterpolationOrder -> 3] &) /@ Transpose[allpts]; Flatten@Table[ Tube[{ Table[fs[[i]][j], {i, Length[fs]}], Table[fs[[i]][j + 0.1], {i, Length[fs]}] }, 0.02] , {j, 0.5 Length[pts], 1.5 Length[pts], 0.1}] ]; circ[x_, n_, e_] := Table[{e Sin[2 Pi i /n] + x, Cos[2 Pi i/n], 0}, {i, n}]; circ2[x_, n_, r_] := Table[{Sin[2 Pi i /n] + x, 0, r Cos[2 Pi i/n]}, {i, n}] circ3[x_, n_, r1_, r2_, \[Alpha]_] := Table[{x, r1 Cos [-2 Pi i /n + \[Alpha]], r2 Sin[-2 Pi i/n + \[Alpha]]}, {i, n}] c2 = circ2[1.7, 12, 1]; loop = { {0.9, 0, -0.5}, {0.6, -0.1, -0.5}, {-0.6, -0.5, -0.1}, {-0.9, -0.5, 0}, {-0.6, -0.5, 0.1}, {0.6, -0.1, 0.5}, {0.9, 0, 0.5}, {0.6, 0.1, 0.5}, {-0.6, 0.5, 0.1}, {-0.9, 0.5, 0}, {-0.6, 0.5, -0.1}, {0.6, 0.1, -0.5} }; frame[t_, i_] := ( Graphics3D[ Rotate[Rotate[ { bez[ If[t > 5, 6 - t, 1] (RotationTransform[ Pi Min[t, 1], {0, 1, 0}, {-0.8 + Min[t^2, 1], 0, 0}] /@ circ[-1.7, 12, 1 + 0.5 Min[t, 1] - If[t > 2, 0.5 (Min[t, 3] - 2), 0]]) + If[t > 5, t - 5, 0] Reverse[circ[-1.7, 12, 1]] ], bez[ If[t > 5, 6 - t, 1] (ScalingTransform[{1, 1, If[t > 3, 1 - 0.2 (Min[t, 4] - 3)^2, 1]}] /@ If[t < 2, c2, TranslationTransform[{2.2 (Min[t, 3] - 2), 0, 0}] /@ ((3 - Min[t, 3]) c2 + (Min[t, 3] - 2) RotateLeft[ Join[circ2[1.7, 12, 0.9][[6 ;;]], Map[(0.85 # + 0.15 {1.7, 0, 0}) &, Reverse[ circ2[1.7, 12, 0.9 - If[t > 3, 0.2 (Min[t, 4] - 3), 0]][[7 ;; -2]]]]], 7])] If[t > 4, 5 - Min[t, 5], 1] + If[t > 4, Min[t, 5] - 4, 0] TranslationTransform[{3, 0, 0}] /@ RotateLeft[loop, 7]) + If[t > 5, t - 5, 0] RotateLeft[loop, 7] ], bez[ If[t > 5, 6 - t, 1] RotationTransform[ If[t > 4, -(Min[t, 5] - 4) Pi/2, 0], {0, 0, 1}, {3.7, 0, 0}] /@ TranslationTransform[{0, If[t > 3, 0.7 (Min[t, 4] - 3), 0], 0}] /@ If[t < 1, loop, loop If[t < 2, (2 - t), 0] + If[t < 2, (t - 1), 1] circ3[ 1.7 + If[t > 2, 2 (Min[t, 3] - 2), 0], 12, If[t > 2, 1.2 - (Min[t, 3] - 2)/5, 1.2], If[t > 2, 0.8 + (Min[t, 3] - 2)/20, 0.8], 5.1145]] + If[t > 5, t - 5, 0] RotateLeft[c2, 6] ] } , i Pi/2, {1, 0, 0}], i Pi, {0, 1, 0}] , Boxed -> False, ImageSize -> {500, 500}]); frames = Join[ Table[frame[t, 0], {t, 0, 6, 6/97}], Table[frame[t, 1], {t, 0, 6, 6/97}]]; Export["borr.gif", Join[frames]]