In[]:=
ConeCircumscribedSphere::usage="By providing the center C{h, k, l} and the radius r of a sphere, and the vertex of a cone V{h1, k1, l1}, also provides the extension in x, y and z: {x0, x1}, {y0, y1}, {z0, z1}; you will get the equation and the graph of the cone circumscribed to the sphere when you evaluate the notebook. Reference: Personal.";
In[]:=
ConeCircumscribedToSphere[{h_,k_,l_},r_,{h1_,k1_,l1_},{x0_,x1_},{y0_,y1_},{z0_,z1_}]:=Module{},Test=Norm[{k,k,l}-{h1,k1,l1}];IfTest<=r,Print[PasteButton["The vertex is on or inside the sphere"]],f[x_,y_,z_,t_]:=++-2hxt-2kyt-2lzt+(++-);[x_,y_,z_,t_]:=-2ht+2x;[x_,y_,z_,t_]:=-2kt+2y;[x_,y_,z_,t_]:=-2lt+2z;[x_,y_,z_,t_]:=-2hx-2ky-2lz+2t(++-);Print[PasteButton["The equation of the circumscribed cone to the sphere is:"]];Print[" "];eq=Expand-4f[h1,k1,l1,1]f[x,y,z,1]//FullSimplify;Print[eq==0];Show[{ParametricPlot3D[{rCos[u]Sin[v]+h,rSin[u]Sin[v]+k,rCos[v]+l},{u,0,2π},{v,0,π},PlotStyle->{Opacity[0.8],Red,Specularity[White,40]},MeshFalse,PerformanceGoal"Quality"],ContourPlot3D[eq==0,{x,x0,x1},{y,y0,y1},{z,z0,z1},ContourStyle->Directive[Green,Opacity[0.3],Specularity[White,40]],MeshFalse,PerformanceGoal->"Quality",PlotPoints->60]},AxesLabel->(Style[#,15,Blue]&/@{"X","Y","Z"}),AxesOrigin{0,0,0},AxesTrue,BoxedFalse,BoxRatiosAutomatic,PlotRange{{x0,x1},{y0,y1},{z0,z1}},ViewPoint{1.3,-2.4,2.},ImageSize700]
2
x
2
y
2
z
2
h
2
k
2
l
2
r
2
t
f
x
f
y
f
z
f
t
2
h
2
k
2
l
2
r
2
(x[h1,k1,l1,1]+y[h1,k1,l1,1]+z[h1,k1,l1,1]+[h1,k1,l1,1])
f
x
f
y
f
z
f
t
Example: Sphere: C{- 2, 4, 5}, r = 5, Cone vertex : {10, 0, - 8}, Extension: {- 15, 15}, {- 15, 15}, {- 15, 15}
In[]:=
ConeCircumscribedToSphere[{-2,4,5},5,{10,0,-8},{-15,15},{-15,15},{-15,15}]
-128(-10+5+x(-22+3y)+y(-56+9y))+32(120-39x+13y)z-5400
2
x
2
z
Out[]=
