Pappus

Spheres:

-

+

n = 13 (slider from 9 to 1000, step 1)
r: 1.2
r': r + 0.05
R: r / sin(pi / n)
R': R + 0.05
cir = Circle((-2, 0), 2)
toro = Surface(r' - R' + (cos(u) * (R' + (r' * cos(v)))), (sin(u) * (R' + (r' * cos(v)))), 6 + (r' * sin(v)), u, 0, (2 * pi), v, 0, (2 * pi))
cilindro = Surface(r' + (r' * cos(u)), v, 6 + (r' * sin(u)), u, 0, (2 * pi), v, -50, 50)
cadena1a = Sequence(Circle[(r - R, 0) + (R; ((2 * pi) * k / 5)), r], k, 0, 4)
cadena2a = Mirror(cadena1a, cir)
circun1 = Circle((r - R, 0), R - r)
circun2 = Circle((r - R, 0), R + r)
c1 = Mirror(circun1, cir)
c2 = Mirror(circun2, cir)
c2': c2
esfera1 = Sphere((-2, 0, 6), 2)
esfera2 = Sphere((x(Center[c2]), 0, 6), Radius[c2])
recta1: yAxis
c1P = Mirror(recta1, cir)
recta2: x = (2 * r)
c2P = Mirror(recta2, cir)
esfera2P = Sphere((x(Center[c2P]), 0, 6), Radius[c2P])
elipse = Conic(Center[cadena2a(1)], Center[cadena2a(2)], Center[cadena2a(3)], Center[cadena2a(4)], Center[cadena2a(5)])
o: x((Center[Mirror[Circle[(r, 0), r], cir]] + Center[Mirror[Circle[(r - (2 * R), 0), r], cir]]) / 2)
oP: x((Center[Mirror[Circle[(r, 0), r], cir]] + (-2, 0)) / 2)
a: (Radius[c1] + Radius[c2]) / 2
c = Excentricity(elipse)
b: sqrt(a^(2) - c^(2))
d: (-(o + a + c))
dupin = Translate(Surface[((-((d * (c - ((a * cos(u)) * cos(v)))) + (b^(2) * cos(u))))) / (a - ((c * cos(u)) * cos(v))), (((b * sin(u)) * (a - (d * cos(v))))) / (a - ((c * cos(u)) * cos(v))), (((b * sin(v)) * ((c * cos(u)) - d))) / (a - ((c * cos(u)) * cos(v))), u, 0, (2 * pi), v, 0, (2 * pi)], Vector[(o, 0, 6)])
pappus = false
α = 4.084070449666731 rad (slider from 0° to 360°, step 1°)
cadena1 = Sequence(Circle[(r - R, 0) + (R; ((k * 2) * pi / n) + α), r], k, 1, n)
cadena2 = Mirror(cadena1, cir)
cadena1p = Sequence(Circle[(r - R, 0) + (R, ((2 * k) * r) + (5 * α)), r], k, -50, 50)
cadena2p = Mirror(cadena1p, cir)
centros: {Zip[Center[c], c, cadena1] + (0, 0, 6), Zip[Center[c], c, cadena2] + (0, 0, 6), Zip[Center[c], c, cadena1p] + (0, 0, 6), Zip[Center[c], c, cadena2p] + (0, 0, 6)}
radios = Zip(Radius[c], c, cadena2)
esferas1 = Zip(Sphere[a, r], a, centros(1))
esferas2 = Zip(Sphere[a, b], a, centros(2), b, radios)
cadena1aP = Sequence(Circle[(r - R, 0) + (R, ((2 * k) * r)), r], k, -2, 2)
cadena2aP = Mirror(cadena1aP, cir)
radiosP = Zip(Radius[c], c, cadena2p)
elipseP = Conic(Center[cadena2aP(1)], Center[cadena2aP(2)], Center[cadena2aP(3)], Center[cadena2aP(4)], Center[cadena2aP(5)])
aP: (Radius[c1P] + Radius[c2P]) / 2
cP = Excentricity(elipseP)
bP: sqrt(aP^(2) - cP^(2))
dP: (-(oP + aP + cP))
esferas1P = Zip(Sphere[a, r], a, centros(3))
esferas2P = Zip(Sphere[a, b], a, centros(4), b, radiosP)
dupinP = Translate(Surface[((-((dP * (cP - ((aP * cos(u)) * cos(v)))) + (bP^(2) * cos(u))))) / (aP - ((cP * cos(u)) * cos(v))), (((bP * sin(u)) * (aP - (dP * cos(v))))) / (aP - ((cP * cos(u)) * cos(v))), (((bP * sin(v)) * ((cP * cos(u)) - dP))) / (aP - ((cP * cos(u)) * cos(v))), u, 0, (2 * pi), v, 0, (2 * pi)], Vector[(oP, 0, 6)])
texto2: " Dupin cychlide enveloping the " + (If[pappus, "Pappus", "Steiner"]) + " chain by inversion of a " + (If[pappus, "cylinder", "torus"]) + " into a sphere                                                     "
tex = 150 (slider from 0 to 150, step 1)
texto2a = First(texto2, Min[Length[texto2], tex])
l1: {Polygon[(-5, 6.6), (3, 6.6), 4]}