我在这里提出一个解决方案。首先我将展示如何使用生成线框的函数，然后我将继续详细解释构成算法的其余函数。
wireFrame
wireFrame[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、getHiddenLines、getFrame 和setPoints 的详细信息之前，我将向您展示为什么去除隐藏线的线框会很有用。
上图是使用rasters in 3D graphics中描述的技术结合此处生成的线框生成的pdf文件的截图。这可以以各种方式有利。无需保留三角形信息以显示彩色表面。相反，我们显示表面的光栅图像。所有的线条都非常平滑，除了光栅图的边界没有被线条覆盖。我们还减少了文件大小。在这种情况下，使用光栅图和线框的组合，pdf 文件的大小从 1.9mb 减少到 78kb。在 pdf 查看器中显示所需的时间更少，图像质量也很好。
Mathematica 在将 3D 图像导出为 pdf 文件方面做得很好。当我们导入 pdf 文件时，我们会得到一个由线段和三角形组成的 Graphics 对象。在某些情况下，这些对象重叠，因此我们有隐藏线。要制作没有曲面的线框模型，我们首先需要移除此重叠，然后移除多边形。我将首先描述如何从 Graphics3D 图像中获取信息。
G3ToG2Info
getPoints[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，您可以将函数 getPoints 中的 JoinedCurve 替换为 Line。函数getPoints 假定您提供的是原始Graphics 对象。它将查看收到的对象类型，然后从中提取所需的信息。如果它是一个多边形，它会得到一个 3 个点的列表，对于一条线，它会得到一个 2 个点的列表，如果它是一个颜色，那么它会得到一个包含 3 个点的单个列表的列表。这样做是为了保持与列表的一致性。
函数setPoints 与getPoints 正好相反。您输入一个点列表，它将决定它是否应该返回一个多边形、一条线或一种颜色。
要获得三角形、线条和颜色的列表，我们使用G3ToG2Info。该功能将使用
ExportString 和 ImportString 从 Graphics3D 版本中获取 Graphics 对象。此信息存储在obj。我们需要执行一些清理工作，首先我们获得obj 的选项。这部分是必要的，因为它可能包含图像的PlotRange。然后我们获得所有Polygon、JoinedCurve 和RGBColor 对象，如obtaining graphics primitives and directives 中所述。最后，我们对所有这些对象应用函数getPoints，以获得三角形、线条和颜色的列表。这部分涵盖了{figInfo, opt} = G3ToG2Info[g]这一行。
getHiddenLines
我们希望能够知道一行的哪一部分不会被显示。为此，我们需要知道两条线段之间的交点。我用来寻找交叉点的算法可以在here找到。
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 不重合。如果线是平行的或者如果包含线段L 的线没有穿过线段M，它将返回-Infinity。如果包含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 的边之一，如果是这种情况，则该线不在三角形内。这是舍入错误可能不好的地方。当Mathematica 导出图像时，有时一条线位于三角形的边缘，但这些坐标存在一定差异。由我们决定线与边缘的距离有多近，否则函数将看到线几乎完全位于三角形内部。这就是函数中第一行的原因。要查看一条线是否位于三角形的边上，我们可以列出三角形和这条线的所有点，并删除所有重复项。在这种情况下，您需要指定重复项。最后，如果我们最终得到一个包含 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 寻求帮助吗？
为了您的方便，我已将代码上传到网络。你可以找到它here。如果您可以将此代码的修改版本应用于问题中的绘图并显示线框，我会将您的解决方案标记为这篇文章的答案。
最好，
J曼努埃尔·洛佩兹