Mathematica：3D线框

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格式获得隐藏线删除的线框。

---

更新：

我已经发布了一个解决这个问题的方法。 问题是代码运行速度很慢。 在当前状态下，无法在此问题中为图像生成线框。 随意玩我的代码。 我在帖子末尾添加了一个链接。 您也可以在此链接中找到代码

---

这里我提出一个解决方案。 首先我将展示如何使用生成线框的函数，然后我将详细解释组成算法的其余功能。

---

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的细节G3ToG2Info ，我会告诉你为什么使用隐藏线删除的线框可能有用。

上面显示的图像是使用3D图形中的栅格描述的技术与此处生成的线框结合生成的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 by Line替换JoinedCurve 。 函数getPoints假定您正在给出一个原始的Graphics对象。 它会看到它收到的是什么类型的对象，然后从中提取它需要的信息。 如果它是一个多边形，它会得到一个3点的列表，对于一条线它会得到一个2点的列表，如果它是一个颜色，那么它会得到一个包含3个点的列表。 这样做是为了保持与列表的一致性。

函数setPoints与getPoints相反。 你输入一个点列表，它将决定它是否应该返回一个多边形，一条线或一个颜色。

要获取我们使用G3ToG2Info的三角形，线条和颜色的列表。 该函数将使用ExportString和ImportString从Graphics3D版本获取Graphics对象。 此信息存储在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不重合。 如果线是平行的，或者包含线段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+(BA)u, A+(BA)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循环的方法，那么我相信这个时间可以缩短。 我可以在这里得到一些帮助堆栈溢出？

为了您的便利，我已将代码上传到网络上。 你可以在这里找到它。 如果您可以将此代码的修改版本应用于问题中的图表并显示线框，我会将您的解决方案标记为本文的答案。

最好的，曼努埃尔洛佩兹

---

这是不对的，但有点有趣：

Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False, PlotStyle -> {EdgeForm[None], FaceForm[Red, None]}, Mesh -> False]

使用无面的FaceForm时，多边形不会呈现。 我不确定有什么方法可以用Mesh线做到这一点。

链接地址: http://www.djcxy.com/p/35631.html

上一篇: Mathematica: 3D wire frames

下一篇: Mathematica: Text in Graphics3D relative to image coordinates