Image 圆锥图像细化

Image 圆锥图像细化,image,math,wolfram-mathematica,geometry,Image,Math,Wolfram Mathematica,Geometry,为了制作一个与平面相交的圆锥体的漂亮三维图形,我选择了对Mathematica中现有方法(即S.Mangano和S.Vang的书)的轻微重新排列。下面的代码被假定为显示所谓的Dandelin结构:内部和外部球体与圆锥体以及与圆锥体相交的平面相切。球体与平面同时相切的点是椭圆的焦点 Block[{r1, r2, m, h1, h2, C1, C2, M, MC1, MC2, T1, T2, cone, slope, plane}, {r1, r2} = {1.4, 3.4}; m

为了制作一个与平面相交的圆锥体的漂亮三维图形,我选择了对Mathematica中现有方法(即S.Mangano和S.Vang的书)的轻微重新排列。下面的代码被假定为显示所谓的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]]
以下是图表:

问题在于两个球体的切点附近都有白点。把上面的代码放到
操作[…灰度[z]…{z,0,1}]
我们可以很容易地“删除”这些斑点,因为z趋于1

  • 有没有人能找到一种不同的方法来去除白斑?我更喜欢z<0.5的
    灰度[z]

  • 我一直对图形中上下球体上的斑点的一种稍有不同的图案感兴趣。你知道怎么解释吗


  • 您可能希望将球体缩小一点:

    Sphere[C1, .98 r1], Sphere[C2, .98 r2]
    
    这是一个黑客,但它避免了交叉口问题

    或者,可以在圆锥体上向上绘制点:

    PlotPoints -> 100
    
    但这会使渲染速度变慢


    编辑:或两者的组合,以帮助提高速度和质量。

    您可以使用具有不同半径的
    管构建圆锥体:

    cone[m_, h_] := {CapForm[None], Tube[{{0, 0, 0}, {0, 0, h}}, {0, h/m}]};
    

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

    cone[m_, h_] := {EdgeForm[], Cone[{{0, 0, h}, {0, 0, 0}}, h/m]};
    
    这在这里效果很好(没有白点)。此外,这不是一个黑客或解决办法。空的
    EdgeForm[]
    用于去除锥形底座的黑色轮廓


    我刚刚意识到,
    Cone[]
    有一个坚实的基础,在附带的图像上也非常明显。因此,这与原始的
    revolvePlot
    版本不完全相同。

    PlotPoints->60
    在我的机器上就足够了,只会使渲染时间增加一倍。@Arnoud,谢谢!设置
    Sphere[C1.985 r1]、Sphere[C2.985 r2]
    PlotPoints->100
    几乎没有可见的白点,但是使用
    Sphere[C1.98 r1]、Sphere[C2.98 r2]
    我不需要额外的
    PlotPoints
    选项。+1用于漂亮的图形(即使它确实有“白点”)!一些关于圆锥曲线的古老数学真的很漂亮,包括你问题中的Dandelin结构。有人能解释一下这是怎么回事吗?交叉点似乎不是基于渲染的多边形。不错。我不知道管的这种变化。它被隐藏在文档页面的“更多信息”部分。