n = 9;
\[Theta] = \[Pi]/n;
\[CapitalDelta]\[Theta] = (2 \[Pi])/n;
R = 0.2;
\[Rho] = R/(1 + 1/Sin[\[Theta]]);
r = \[Rho] (1/Sin[\[Theta]] - 1);
center = {.3, 0};
plots = Reap[For[start = 0, start <= 2 \[Pi], start = start + 0.05,
      CandR = 
       Table[{center[[1]] + (\[Rho] + r) Cos[i], 
         center[[2]] + (\[Rho] + r) Sin[i], \[Rho]}, {i, start, 
         start + (n - 
             1)*\[CapitalDelta]\[Theta], \[CapitalDelta]\[Theta]}];
      createcoord[{x_, y_, 
         z_}] := {(x )/(x^2 + y^2 - z^2), (y)/(x^2 + y^2 - z^2), 
        z/(x^2 + y^2 - z^2)};
      
      innerc = createcoord[Flatten[{center, r}]];
      outherc = createcoord[Flatten[{center, R}]];
      ellipseCenter = {(outherc[[1]] + innerc[[1]])/2, 0};
      ellipseA = 
       Abs[createcoord[{center[[1]] + \[Rho] + r, 0, \[Rho]}][[1]] - 
         ellipseCenter[[1]]];
      ellipseC = (outherc[[1]] - innerc[[1]])/2;
      ellipseB = Sqrt[ellipseA^2 - ellipseC^2];
      tmp = Map[createcoord, CandR];
      p1 = {x, y} /. 
        Solve[{(x - tmp[[1, 1]])^2 + (y - tmp[[1, 2]])^2 == 
             tmp[[1, 
              3]]^2 && (x - tmp[[2, 1]])^2 + (y - tmp[[2, 2]])^2 == 
             tmp[[2, 3]]^2}, {x, y}][[1]];
      p2 = {x, y} /. 
        Solve[{(x - tmp[[3, 1]])^2 + (y - tmp[[3, 2]])^2 == 
             tmp[[3, 
              3]]^2 && (x - tmp[[2, 1]])^2 + (y - tmp[[2, 2]])^2 == 
             tmp[[2, 3]]^2}, {x, y}][[1]];
      p3 = {x, y} /. 
        Solve[{(x - tmp[[3, 1]])^2 + (y - tmp[[3, 2]])^2 == 
             tmp[[3, 
              3]]^2 && (x - tmp[[4, 1]])^2 + (y - tmp[[4, 2]])^2 == 
             tmp[[4, 3]]^2}, {x, y}][[1]];
      c = 
       Abs[{xc, yc, rc} /. 
         Solve[((#1 - xc)^2 + (#2 - yc)^2 == rc^2) & @@@ {p1, p2, 
             p3}, {xc, yc, rc}][[1]] ];
      Sow@Show[
        Graphics[{Orange, Thick, 
          Evaluate[Circle[{c[[1]], c[[2]]}, c[[3]]] ]}],
        Graphics[{Black, Thick, 
          Circle[{#1, #2}, #3] & @@@ Map[createcoord, CandR] }],
        Graphics[{Blue, Thick, 
          Circle[{#1, #2}, #3] & @@@ {innerc, outherc} }],
        Graphics[{Red, Thick, 
          Circle[ellipseCenter, {ellipseA, ellipseB}]}],
        Graphics[{PointSize[0.02], 
          Point[Map[createcoord, CandR][[All, 1 ;; 2]]] }]
        ];
      ];][[2, 1]];
ListAnimate[plots]

この作品の著作権者である私は、この作品を以下のライセンスで提供します。

	このファイルはクリエイティブ・コモンズ CC0 1.0 全世界 パブリック・ドメイン提供のもとで利用可能にされています。
	ある作品に本コモンズ証を関連づけた者は、その作品について世界全地域において著作権法上認められる、その者が持つすべての権利（その作品に関する権利や隣接する権利を含む。）を、法令上認められる最大限の範囲で放棄して、パブリック・ドメインに提供しています。 この作品は、たとえ営利目的であっても、許可を得ずに複製、改変・翻案、配布、上演・演奏することが出来ます。 http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse

当初、https://twitter.com/j_bertolotti/status/1039543306433249280に投稿されたこのファイルは、2018年10月19日に画像査読者のRonhjonesによって査読され、その時点で、記載されたライセンスの下で利用可能であることが確認されました。