image - 锥体图像细化

为了制作一个与平面相交的圆锥体的精美三维图形，我选择对Mathematica中现有方法(即S.Mangano和S.Wagon的书)进行稍微的重新排列。假定下面的代码显示出所谓的Dandelin结构:内部和外部球体在内部与圆锥体相切，并且还与与圆锥体相交的平面相切。球体与平面的切线点同时是椭圆的焦点。

 Block[{r1, r2, m, h1, h2, C1, C2, M, MC1, MC2, T1, T2, cone, slope, plane},
   {r1, r2} = {1.4, 3.4};
    m = Tan[70.*Degree];
    h1 := r1*Sqrt[1 + m^2];
    h2 := r2*Sqrt[1 + m^2];
    C1 := {0, 0, h1};
    C2 := {0, 0, h2};
    M = {0, MC1 + h1};
    MC2 = MC1*(r2/r1);
    MC1 = (r1*(h2 - h1))/(r1 + r2);
    T1 = C1 + r1*{-Sqrt[1 - r1^2/MC1^2], 0, r1/MC1};
    T2 = C2 + r2*{Sqrt[1 - r2^2/MC2^2], 0, -(r2/MC2)};

    cone[m_, h_] := RevolutionPlot3D[{t, m*t}, {t, 0, h/m}, Mesh -> False][[1]];
    slope = (T2[[3]] - T1[[3]])/(T2[[1]] - T1[[1]]);
    plane = ParametricPlot3D[{t, u, slope*t + M[[2]]}, {t, -2*m, 12/m}, {u, -3, 3},
                              Boxed -> False, Axes -> False][[1]];
    Graphics3D[{{Gray, Opacity[0.39], cone[m, 1.2*(h2 + r2)]},
                {Opacity[0.5], Sphere[C1, r1], Sphere[C2, r2]},
                {LightBlue, Opacity[0.6], plane},
                 PointSize[0.0175], Point[T1], Point[T2]},
                 Boxed -> False, Lighting -> "Neutral",
                 ViewPoint -> {-1.8, -2.5, 1.5}, ImageSize -> 950]]

这是图形:


问题在于两个球体上相切点附近的白点。将上面的代码放入Manipulate[...GrayLevel[z]...{z,0,1} ]中，我们可以轻松地“去除” Blob ，因为z趋于1。

谁能看到另一种去除白点的方法吗？我更喜欢z GrayLevel[z]。

我对图形的上下球上的 Blob 图案略有不同感到很感兴趣。您有什么想法可以解释吗？

最佳答案

为什么没有人建议只使用内置的Cone[]原语？

cone[m_, h_] := {EdgeForm[], Cone[{{0, 0, h}, {0, 0, 0}}, h/m]};

这在这里工作正常(没有白色 Blob )。而且，这不是黑客或解决方法。空EdgeForm[]的目的是删除圆锥形基座的黑色轮廓。

我刚刚意识到Cone[]具有坚实的基础，在包含的图像上也非常明显。因此，这与原始RevolutionPlot版本不完全相同。

关于image - 锥体图像细化，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/8235778/