PencilsCirclesSpheres::usage="A circle is drawn that passes through the origin and its center is on the X axis, its radius is r = a . From there, the circumferences of the Pencil are drawn, which have their center on the base circumference and pass through the origin. The envelope of this Pencil is a cardioid, then the problem is transferred to 3D. References: Public domain; Personal adaptation.";
Development in 2D:
Center and radius of each circle on the Pencil:
C1[θ_]:={a+aCos[θ],aSin[θ]};​​R[θ_]:=Norm[C1[θ]-{0,0}];​​
Family of circles (Pencil):
2
(x-(a+aCos[θ]))
+
2
(y-aSin[θ])
==
2
R[θ]
;
Envelope:
Norm[{a+aCos[θ],aSin[θ]}-{0,0}]
2
Abs[a+aCos[θ]]
+
2
Abs[aSin[θ]]
;​​2aCos
θ
2
;
In[]:=
Solve
2
(x-(a+aCos[θ]))
+
2
(y-aSin[θ])
==4
2
a
2
Cos
θ
2

,
∂
θ
2
(x-(a+aCos[θ]))
+
2
(y-aSin[θ])
-4
2
a
2
Cos
θ
2

==0,{x,y}//FullSimplify
{{x0,y0},{x2aCos[θ](1+Cos[θ]),y2a(1+Cos[θ])Sin[θ]}};​​ξ[θ_]:={2aCos[θ](1+Cos[θ]),2a(1+Cos[θ])Sin[θ]};
In[]:=
SwatchLegend[{Black,DarkGreen,LightGray},{"Envelope (cardioid)","Base circle and centers of Pencil's circles","Pencil of circles"}]​​Manipulatea=4;ζ[θ_]:=2aCos
θ1
2
Cos[θ]+a+aCos[θ1],2aCos
θ1
2
Sin[θ]+aSin[θ1];ξ[θ_]:={2aCos[θ](1+Cos[θ]),2a(1+Cos[θ])Sin[θ]};ShowTableParametricPlot[ζ[θ],{θ,0,2π},PlotStyle->{LightGray,Thick}],θ1,0,t1,
π
12
,​​ParametricPlot[ξ[θ],{θ,0,2π},PlotStyle->{Black,Thick}],Graphics[{DarkGreen,PointSize[0.01],Point[{a+aCos[t1],aSin[t1]}]}],Graphics[{DarkGreen,Thick,Circle[{a,0},a]}],AxesTrue,ImageSize700,PlotRangeAll,AxesOrigin{0,0},AspectRatio->Automatic,t1,0.00001,2π,
π
12
,SaveDefinitions->True,ControlPlacement->Top
Out[]=
Envelope (cardioid)
Base circle and centers of Pencil's circles
Pencil of circles
Development in 3D:
Center and radius of each sphere on the Pencil:
C2[u_,v_]:={aCos[u]Sin[v]+a,aSin[u]Sin[v],aCos[v]};​​R2[u_,v_]:=Norm[C2[u,v]-{0,0,0}];
Family od spheres (Pencil):
2
(x-(aCos[u]Sin[v]+a))
+
2
(y-aSin[u]Sin[v])
+
2
(z-aCos[v])
==
2
R2[u,v]
;
Envelope:
In[]:=
Norm[{aCos[u]Sin[v]+a,aSin[u]Sin[v],aCos[v]}-{0,0,0}]
16
2
Abs[Cos[v]]
+16
2
Abs[Sin[u]Sin[v]]
+
2
Abs[4+4Cos[u]Sin[v]]
;​​
16
2
Cos[v]
+16
2
(Sin[u]Sin[v])
+
2
(4+4Cos[u]Sin[v])
;
In[]:=
Solve[
2
(x-(aCos[u]Sin[v]+a))
+
2
(y-aSin[u]Sin[v])
+
2
(z-aCos[v])
==16
2
Cos[v]
+16
2
(Sin[u]Sin[v])
+
2
(4+4Cos[u]Sin[v])
,
∂
u
(
2
(x-(aCos[u]Sin[v]+a))
+
2
(y-aSin[u]Sin[v])
+
2
(z-aCos[v])
-(16
2
Cos[v]
+16
2
(Sin[u]Sin[v])
+
2
(4+4Cos[u]Sin[v])
))==0,
∂
v
(
2
(x-(aCos[u]Sin[v]+a))
+
2
(y-aSin[u]Sin[v])
+
2
(z-aCos[v])
-(16
2
Cos[v]
+16
2
(Sin[u]Sin[v])
+
2
(4+4Cos[u]Sin[v])
))==0,{x,y,z}]//FullSimplify
{{x0,y0,z0},{x8Cos[u]Sin[v](1+Cos[u]Sin[v]),y8Sin[u]Sin[v](1+Cos[u]Sin[v]),z8Cos[v](1+Cos[u]Sin[v])}};
ξ2[u_,v_]:={8Cos[u]Sin[v](1+Cos[u]Sin[v]),8Sin[u]Sin[v](1+Cos[u]Sin[v]),8Cos[v](1+Cos[u]Sin[v])};
In[]:=
SwatchLegend[{Yellow,Green,Black,Orange},{"Envelope","Base sphere","Centers of the Pencil's spheres","Pencil of spheres"}]​​Manipulatea=4;ζ2[u_,v_]:=
16
2
Cos[v1]
+16
2
(Sin[u1]Sin[v1])
+
2
(4+4Cos[u1]Sin[v1])
Cos[u]Sin[v]+aCos[u1]Sin[v1]+a,
16
2
Cos[v1]
+16
2
(Sin[u1]Sin[v1])
+
2
(4+4Cos[u1]Sin[v1])
Sin[u]Sin[v]+aSin[u1]Sin[v1],
16
2
Cos[v1]
+16
2
(Sin[u1]Sin[v1])
+
2
(4+4Cos[u1]Sin[v1])
Cos[v]+aCos[v1];ξ2[u_,v_]:={8Cos[u]Sin[v](1+Cos[u]Sin[v]),8Sin[u]Sin[v](1+Cos[u]Sin[v]),8Cos[v](1+Cos[u]Sin[v])};ShowTableParametricPlot3D[ζ2[u,v],{u,0,2π},{v,0,π},PlotStyle->{Orange,Specularity[White,10],Opacity[0.2]},MeshFalse,PerformanceGoal->"Quality"],u1,0,t1,
π
3
,v1,0,
t1
2
,
π
3
,​​ParametricPlot3D[ξ2[u,v],{u,0,2π},{v,0,π},PlotStyle->{Yellow,Opacity[0.1],Specularity[White,10]},MeshFalse,PerformanceGoal->"Quality"],Graphics3DBlack,BallaCos[t1]Sin
t1
2
+a,aSin[t1]Sin
t1
2
,aCos
t1
2
,0.2,Graphics3D[{Green,Opacity[0.6],Specularity[White,10],Sphere[{a,0,0},a]}],AxesTrue,ImageSize700,ViewPoint{20,-100,50.},BoxedFalse,PlotRangeAll,AxesOrigin{0,0,0},BoxRatios->Automatic,t1,0.00001,2π,
π
3
,SaveDefinitions->True,ControlPlacement->Top
Out[]=
Envelope
Base sphere
Centers of the Pencil's spheres
Pencil of spheres
Out[]=
​
t1