Попытка сделать приятную трехмерную графику конуса, пересекаемого плоскостью, я выбираю небольшую перестановку существующего подхода в Mathematica (т.е. книги С.Мангано и С. Вагона). Предполагается, что код внизу будет обозначать так называемую конструкцию Данделина: внутренняя и внешняя сферы касаются внутри конуса, а также плоскости, пересекающей конус. Одновременные точки сфер на плоскость в то же время являются очагами эллипса.
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} ], мы можем easliy "удалить" пятна, поскольку z стремится к 1.
-
Может ли кто-нибудь увидеть другой подход к удалению белых пятен? Я предпочитаю
GrayLevel[z]с z < 0.5. -
Я был заинтригован слегка отличающимся рисунком пятен в нижней и верхней сферах графики. У вас есть идеи, как это можно объяснить?
