2011-11-23 74 views
12

试图制作一个与平面相交的圆锥体的三维立体图形,我选择Mathematica中现有方法(即S.Mangano和S.Wagon的书籍)的轻微重排。下面的代码假定显示所谓的丹德林结构:内部和外部球体在内部与锥体相切,也与锥体相交的平面相切。同时球面到平面的切点是椭圆的焦点。圆锥图像细化

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]] 

这里是显卡: Dandelin construction

的问题是近切点的两个领域周围的白色斑点。把上面的代码Manipulate[...GrayLevel[z]...{z,0,1} ]我们可以easliy“删除”斑点为z趋于1.

  1. 任何人都可以看到不同的方法来消除白斑?我更喜欢GrayLevel[z]与z < 0.5。

  2. 我一直对图形上较低和较高球体上的斑点略有不同的模式感兴趣。你有什么想法可以解释这个吗?

+0

为漂亮的图形+1(即使它确实有“白点”)!圆锥形部分的那些旧数学中的一些非常漂亮,包括你的问题中的丹德林构造。 – Simon

回答

5

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

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

这工作很好(没有白点)。此外,这不是一个黑客或解决方法。空的EdgeForm[]的目的是去除锥形底座的黑色轮廓。

enter image description here

我刚刚意识到Cone[]有一个坚实的基础,也将包含在图片上非常明显。所以这不是正好版本与原来的RevolutionPlot版本相同。

6

你可能想使球一点点小:

Sphere[C1, .98 r1], Sphere[C2, .98 r2] 

这是一个黑客,但它避免了交叉点的问题。

另外,您最多可以在锥PlotPoints:

PlotPoints -> 100 

但是,这将使渲染速度较慢。

编辑:或这些的组合,以帮助速度和质量。

+1

在我的机器上'PlotPoints - > 60'就足够了,只需要渲染的时间加倍。 –

+0

@Arnoud,谢谢!设置球体[C1,.985 r1],球体[C2,...。985 r2]'和'PlotPoints - > 100'几乎没有可见的白色点,但是球体[C1,.98 r1],球体[C2,.98 r2]'我不需要额外的'PlotPoints'选项。 – Artes

9

你可以使用Tube具有不同半径构造锥:

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

有趣... –

+0

请问有人请解释这是如何工作的?该交点似乎不基于渲染的多边形。 –

+0

不错的。我并不知道“Tube”的变化。它隐藏在文档页面的“更多信息”部分。 –