Mathematica 是否支持去除线框图像的隐藏线？如果不是这种情况，这里有没有人遇到过这样做的方法？让我们从这个开始：
Plot3D[Sin[x+y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False]
要创建线框，我们可以这样做：
Plot3D[Sin[x+y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False, PlotStyle -> None]
为了达到这种效果，我们可以做的一件事就是将所有表面涂成白色。然而，这是不希望的。原因是如果我们将这个隐藏线线框模型导出为 pdf，我们将拥有 Mathematica 用来渲染图像的所有白色多边形。我希望能够以 pdf 和/或 eps 格式获得带有隐藏线删除的线框。
我已经发布了这个问题的解决方案。问题是代码运行速度很慢。在当前状态下，它无法为该问题中的图像生成线框。随意玩我的代码。我在帖子末尾添加了一个链接。您还可以在此链接中找到代码
这里我提出一个解决方案。首先，我将展示如何使用生成线框的函数，然后我将继续详细解释构成算法的其余函数。
wireFramewireFrame[g_] := Module[{figInfo, opt, pts},
{figInfo, opt} = G3ToG2Info[g];
pts = getHiddenLines[figInfo];
Graphics[Map[setPoints[#] &, getFrame[figInfo, pts]], opt]
]
这个函数的输入是一个Graphics3D最好没有轴的对象。
fig = ListPlot3D[
{{0, -1, 0}, {0, 1, 0}, {-1, 0, 1}, {1, 0, 1}, {-1, 1, 1}},
Mesh -> {10, 10},
Boxed -> False,
Axes -> False,
ViewPoint -> {2, -2, 1},
ViewVertical -> {0, 0, 1},
MeshStyle -> Directive[RGBColor[0, 0.5, 0, 0.5]],
BoundaryStyle -> Directive[RGBColor[1, 0.5, 0, 0.5]]
]
现在我们应用函数wireFrame。
wireFrame[fig]
如您所见wireFrame，获得了大部分线条及其颜色。有一条绿线未包含在线框中。这很可能是由于我的阈值设置。
在我继续解释函数的细节之前，我G3ToG2Info将向您展示为什么带有隐藏线移除的线框会很有用。getHiddenLinesgetFramesetPoints
上面显示的图像是使用3D 图形中的栅格中描述的技术结合此处生成的线框生成的 pdf 文件的屏幕截图。这可以以各种方式有利。无需保留三角形信息以显示彩色表面。相反，我们显示表面的光栅图像。所有的线条都非常平滑，除了光栅图的边界没有被线条覆盖。我们还减少了文件大小。在这种情况下，使用光栅图和线框的组合，pdf 文件的大小从 1.9mb 减少到 78kb。在 pdf 查看器中显示所需的时间更少，图像质量也很好。
Mathematica在将 3D 图像导出为 pdf 文件方面做得很好。当我们导入 pdf 文件时，我们会得到一个由线段和三角形组成的 Graphics 对象。在某些情况下，这些对象重叠，因此我们有隐藏线。要制作没有曲面的线框模型，我们首先需要移除此重叠，然后移除多边形。我将首先描述如何从 Graphics3D 图像中获取信息。
G3ToG2InfogetPoints[obj_] := Switch[Head[obj],
Polygon, obj[[1]],
JoinedCurve, obj[[2]][[1]],
RGBColor, {Table[obj[[i]], {i, 1, 3}]}
];
setPoints[obj_] := Switch[Length@obj,
3, Polygon[obj],
2, Line[obj],
1, RGBColor[obj[[1]]]
];
G3ToG2Info[g_] := Module[{obj, opt},
obj = ImportString[ExportString[g, "PDF", Background -> None], "PDF"][[1]];
opt = Options[obj];
obj = Flatten[First[obj /. Style[expr_, opts___] :> {opts, expr}], 2];
obj = Cases[obj, _Polygon | _JoinedCurve | _RGBColor, Infinity];
obj = Map[getPoints[#] &, obj];
{obj, opt}
]
此代码适用于版本 7 中的Mathematica 8，您将JoinedCurve在函数中替换getPoints为Line. 该函数getPoints假定您正在提供一个原始Graphics对象。它将查看收到的对象类型，然后从中提取所需的信息。如果它是一个多边形，它会得到一个 3 个点的列表，对于一条线，它会得到一个 2 个点的列表，如果它是一个颜色，那么它会得到一个包含 3 个点的单个列表的列表。这样做是为了保持与列表的一致性。
该函数setPoints与getPoints. 您输入一个点列表，它将确定它是否应该返回一个多边形、一条线或一种颜色。
要获得三角形、线条和颜色的列表，我们使用G3ToG2Info. 此函数将使用
ExportString和从版本ImportString中获取Graphics对象。Graphics3D此信息存储在obj. 我们需要执行一些清理工作，首先我们获得obj. 这部分是必要的，因为它可能包含PlotRange图像的。然后我们获取所有Polygon,JoinedCurve和RGBColor对象，如获取图形基元和指令中所述。最后，我们将函数getPoints应用于所有这些对象，以获得三角形、线条和颜色的列表。这部分涵盖了这条线{figInfo, opt} = G3ToG2Info[g]。
getHiddenLines我们希望能够知道一行的哪一部分不会被显示。为此，我们需要知道两条线段之间的交点。我用来寻找交点的算法可以在这里找到。
lineInt[L_, M_, EPS_: 10^-6] := Module[
{x21, y21, x43, y43, x13, y13, numL, numM, den},
{x21, y21} = L[[2]] - L[[1]];
{x43, y43} = M[[2]] - M[[1]];
{x13, y13} = L[[1]] - M[[1]];
den = y43*x21 - x43*y21;
If[den*den < EPS, Return[-Infinity]];
numL = (x43*y13 - y43*x13)/den;
numM = (x21*y13 - y21*x13)/den;
If[numM < 0 || numM > 1, Return[-Infinity], Return[numL]];
]
lineInt假设线L和M不重合。-Infinity如果线平行或包含线段L的线不与线段相交，它将返回M。如果包含L的线与线段相交，M则它返回一个标量。假设这个标量是u，那么交点是L[[1]] + u (L[[2]]-L[[1]])。请注意，u任何实数都可以。您可以使用此操作函数来测试其lineInt工作原理。
Manipulate[
Grid[{{
Graphics[{
Line[{p1, p2}, VertexColors -> {Red, Red}],
Line[{p3, p4}]
},
PlotRange -> 3, Axes -> True],
lineInt[{p1, p2}, {p3, p4}]
}}],
{{p1, {-1, 1}}, Locator, Appearance -> "L1"},
{{p2, {2, 1}}, Locator, Appearance -> "L2"},
{{p3, {1, -1}}, Locator, Appearance -> "M1"},
{{p4, {1, 2}}, Locator, Appearance -> "M2"}
]
现在我们知道了我们必须从L[[1]]线段到线段的距离，M我们可以找出线段的哪一部分位于三角形内。
lineInTri[L_, T_] := Module[{res},
If[Length@DeleteDuplicates[Flatten[{T, L}, 1], SquaredEuclideanDistance[#1, #2] < 10^-6 &] == 3, Return[{}]];
res = Sort[Map[lineInt[L, #] &, {{T[[1]], T[[2]]}, {T[[2]], T[[3]]}, {T[[3]], T[[1]]} }]];
If[res[[3]] == Infinity || res == {-Infinity, -Infinity, -Infinity}, Return[{}]];
res = DeleteDuplicates[Cases[res, _Real | _Integer | _Rational], Chop[#1 - #2] == 0 &];
If[Length@res == 1, Return[{}]];
If[(Chop[res[[1]]] == 0 && res[[2]] > 1) || (Chop[res[[2]] - 1] == 0 && res[[1]] < 0), Return[{0, 1}]];
If[(Chop[res[[2]]] == 0 && res[[1]] < 0) || (Chop[res[[1]] - 1] == 0 && res[[2]] > 1), Return[{}]];
res = {Max[res[[1]], 0], Min[res[[2]], 1]};
If[res[[1]] > 1 || res[[1]] < 0 || res[[2]] > 1 || res[[2]] < 0, Return[{}], Return[res]];
]
L此函数返回需要删除的行部分。例如，如果它返回{.5, 1}这意味着您将删除 50% 的线，从线段的一半开始到线段的终点。如果L = {A, B}并且函数返回{u, v}，则这意味着线段{A+(B-A)u, A+(B-A)v}是它包含在三角形中的线段T。
在实现时lineInTri，您需要注意该线L不是 的边缘之一T，如果是这种情况，则该线不在三角形内。这是舍入错误可能不好的地方。当数学导出图像有时一条线位于三角形的边缘，但这些坐标存在一定差异。由我们决定线与边缘的距离有多近，否则函数将看到线几乎完全位于三角形内部。这就是函数中第一行的原因。要查看一条线是否位于三角形的边上，我们可以列出三角形和这条线的所有点，并删除所有重复项。在这种情况下，您需要指定重复项。最后，如果我们最终得到一个包含 3 个点的列表，这意味着一条线位于一条边上。下一部分有点复杂。我们要做的是检查直线L与三角形每条边的交点T并将结果存储在列表中。接下来我们对列表进行排序并找出线的哪个部分（如果有）位于三角形中。尝试通过玩这个来理解它，一些测试包括检查线的端点是否是三角形的顶点，线是否完全在三角形内部，部分在内部或完全在外部。
Manipulate[
Grid[{{
Graphics[{
RGBColor[0, .5, 0, .5], Polygon[{p3, p4, p5}],
Line[{p1, p2}, VertexColors -> {Red, Red}]
},
PlotRange -> 3, Axes -> True],
lineInTri[{p1, p2}, {p3, p4, p5}]
}}],
{{p1, {-1, -2}}, Locator, Appearance -> "L1"},
{{p2, {0, 0}}, Locator, Appearance -> "L2"},
{{p3, {-2, -2}}, Locator, Appearance -> "T1"},
{{p4, {2, -2}}, Locator, Appearance -> "T2"},
{{p5, {-1, 1}}, Locator, Appearance -> "T3"}
]
lineInTri将用于查看线条的哪一部分不会被绘制。这条线很可能被许多三角形覆盖。出于这个原因，我们需要保留每条线中不会绘制的所有部分的列表。这些列表将没有顺序。我们所知道的是，这个列表是一维段。每一个都由[0,1]区间中的数字组成。我不知道一维段的联合函数，所以这是我的实现。
union[obj_] := Module[{p, tmp, dummy, newp, EPS = 10^-3},
p = Sort[obj];
tmp = p[[1]];
If[tmp[[1]] < EPS, tmp[[1]] = 0];
{dummy, newp} = Reap[
Do[
If[(p[[i, 1]] - tmp[[2]]) > EPS && (tmp[[2]] - tmp[[1]]) > EPS,
Sow[tmp]; tmp = p[[i]],
tmp[[2]] = Max[p[[i, 2]], tmp[[2]]]
];
, {i, 2, Length@p}
];
If[1 - tmp[[2]] < EPS, tmp[[2]] = 1];
If[(tmp[[2]] - tmp[[1]]) > EPS, Sow[tmp]];
];
If[Length@newp == 0, {}, newp[[1]]]
]
这个函数会更短，但在这里我包含了一些 if 语句来检查一个数字是接近零还是接近一。如果一个数字EPS与零不同，那么我们将这个数字设为零，这同样适用于一。我在这里要介绍的另一个方面是，如果要显示的段的部分相对较小，则很可能需要将其删除。例如，如果我们有{{0,.5}, {.500000000001}}这意味着我们需要绘制{{.5, .500000000001}}. 但是这个线段非常小，甚至在一条大线段中也不能特别注意，因为我们知道这两个数字是相同的。所有这些都需要在实施时加以考虑union。
现在我们准备好查看需要从线段中删除的内容。接下来需要从 生成G3ToG2Info的对象列表、来自该列表的对象和索引。
getSections[L_, obj_, start_ ] := Module[{dummy, p, seg},
{dummy, p} = Reap[
Do[
If[Length@obj[[i]] == 3,
seg = lineInTri[L, obj[[i]]];
If[Length@seg != 0, Sow[seg]];
]
, {i, start, Length@obj}
]
];
If[Length@p == 0, Return[{}], Return[union[First@p]]];
]
getSections返回一个列表，其中包含需要从中删除的部分L。我们知道这obj是三角形、线条和颜色的列表，我们知道列表中具有较高索引的对象将被绘制在具有较低索引的对象之上。出于这个原因，我们需要索引start。这是我们将开始在 中寻找三角形的索引obj。一旦我们找到一个三角形，我们将使用函数获得位于三角形中的线段部分lineInTri。最后，我们将得到一个部分列表，我们可以使用union.
最后，我们到达getHiddenLines. 所有这些都需要查看返回的列表中的每个对象G3ToG2Info并应用该函数getSections。getHiddenLines将返回列表列表。每个元素都是需要删除的部分的列表。
getHiddenLines[obj_] := Module[{pts},
pts = Table[{}, {Length@obj}];
Do[
If[Length@obj[[j]] == 2,
pts[[j]] = getSections[obj[[j]], obj, j + 1]
];
, {j, Length@obj}
];
Return[pts];
]
getFrame如果你已经设法理解了这里的概念，我相信你知道接下来会做什么。如果我们有三角形、线条和颜色的列表以及需要删除的线条部分，我们只需要绘制可见的颜色和线条部分。首先我们创建一个complement函数，它会准确地告诉我们要绘制什么。
complement[obj_] := Module[{dummy, p},
{dummy, p} = Reap[
If[obj[[1, 1]] != 0, Sow[{0, obj[[1, 1]]}]];
Do[
Sow[{obj[[i - 1, 2]], obj[[i, 1]]}]
, {i, 2, Length@obj}
];
If[obj[[-1, 2]] != 1, Sow[{obj[[-1, 2]], 1}]];
];
If[Length@p == 0, {}, Flatten@ First@p]
]
现在getFrame函数
getFrame[obj_, pts_] := Module[{dummy, lines, L, u, d},
{dummy, lines} = Reap[
Do[
L = obj[[i]];
If[Length@L == 2,
If[Length@pts[[i]] == 0, Sow[L]; Continue[]];
u = complement[pts[[i]]];
If[Length@u > 0,
Do[
d = L[[2]] - L[[1]];
Sow[{L[[1]] + u[[j - 1]] d, L[[1]] + u[[j]] d}]
, {j, 2, Length@u, 2 }]
];
];
If[Length@L == 1, Sow[L]];
, {i, Length@obj}]
];
First@lines
]
我对算法的结果有些满意。我不喜欢的是执行速度。我已经像在 C/C++/java 中使用循环一样编写了这个。我尽力使用Reap并Sow创建不断增长的列表，而不是使用函数Append。尽管如此，我仍然不得不使用循环。需要注意的是，这里发布的线框图片生成需要 63 秒。我尝试为问题中的图片制作线框，但这个 3D 对象包含大约 32000 个对象。计算一行需要显示的部分大约需要 13 秒。如果我们假设我们有 32000 行并且需要 13 秒来完成所有计算，这将是大约 116 小时的计算时间。
Compile我敢肯定，如果我们在所有例程上使用该函数，并且可能找到不使用Do循环的方法，则可以减少此时间。我可以在这里获得一些帮助 Stack Overflow 吗？
为了您的方便，我已将代码上传到网络。你可以在这里找到它。如果您可以将此代码的修改版本应用于问题中的情节并显示线框，我会将您的解决方案标记为这篇文章的答案。
最佳，J 曼努埃尔·洛佩兹
这是不对的，但有点有趣：
Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False,
PlotStyle -> {EdgeForm[None], FaceForm[Red, None]}, Mesh -> False]
FaceForm 为 None 时，不会渲染多边形。我不确定有没有办法用网格线做到这一点。