curve[\[Theta]_] := {0.7 Sin[\[Theta]], Cos[\[Theta]]}; \[Theta]2[curve_, \[Theta]_, l_] := Module[{solns, \[Theta]2}, solns = \[Theta]t /. (Quiet@ NSolve[Norm[curve[\[Theta]t] - curve[\[Theta]]] == l, \[Theta]t]); \[Theta]2 = SortBy[solns, Mod[\[Theta] - #, 2 Pi] &][[1]] ]; l = 1.3; n = 300; \[Theta]s = Table[N@\[Theta], {\[Theta], 0, 2 Pi, 2 Pi/n}]; \[Theta]2s = Table[\[Theta]2[curve, \[Theta], l], {\[Theta], \[Theta]s}]; m = 20; js = Flatten@Table[If[j != 0.5, j, {}], {j, 1/m, 1 - 1/m, 1/m}]; AppendTo[js, 0.5]; Manipulate[ Module[{p, q, lower, upper}, p = curve[\[Theta]s[[Mod[i, n, 1]]]]; q = curve[\[Theta]2s[[Mod[i, n, 1]]]]; If[i < n, lower = 1; upper = i; , lower = i - n; upper = n; ]; Show[ Graphics[{ {Thick, Black, Line@(curve /@ \[Theta]s)}, Table[ { If[j == 1/2, Directive[Thick, Black], ColorData["DarkRainbow"][j]], Line@(j curve /@ (\[Theta]s[[lower ;; upper]]) + (1 - j) curve /@ (\[Theta]2s[[lower ;; upper]]))}, {j, js}], { PointSize[Medium], {Darker@Red, PointSize[Large], Point[{p, q}]}, { Table[ {Darker@ColorData["DarkRainbow"][j], Point[{j p + (1 - j) q}]}, {j, js}] } }, Line[{p, q}] }, ImageSize -> 200] ] ], {i, 1, 2 n, 1}]