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格式获得具有隐藏线去除功能的线框。更新：我已经发布了针对该问题的解决方案。问题在于代码运行非常缓慢。在当前状态下，无法生成此问题中图像的线框。随意玩我的代码。我在文章末尾添加了指向它的链接。您也可以在此链接中找到代码

已邀请:

2 个回复

皇小福另届

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

wireFrame[g_] := Module[{figInfo, opt, pts},
   {figInfo, opt} = G3ToG2Info[g];
   pts = getHiddenLines[figInfo];
   Graphics[Map[setPoints[#] &, getFrame[figInfo, pts]], opt]
]

该功能的输入是“ 4”对象，最好没有轴。

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]

如您所见，ѭ2获得了大部分线条及其颜色。线框中没有包含一条绿线。这很可能是由于我的阈值设置。在继续解释功能G3ToG2Info，getHiddenLines，getFrame和setPoints的细节之前，我将向您展示为什么隐藏线去除的线框会很有用。上面显示的图像是使用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中的JoinedCurve替换为Line。函数“ 16”假设您要提供原始的“ 19”对象。它将看到它接收什么类型的对象，然后从中提取所需的信息。如果是多边形，则得到3点的列表，对于线，则得到2点的列表，如果是颜色，则得到包含3点的单个列表的列表。这样做是为了保持与列表的一致性。 setPoints功能与getPoints相反。输入一个点列表，它将确定它是否应返回多边形，直线或颜色。为了获得三角形，直线和颜色的列表，我们使用G3ToG2Info。该功能将使用 ExportString和ImportString从Graphics3D版本获得Graphics对象。此信息存储在obj中。我们需要执行一些清理工作，首先要获得obj的选项。这部分是必要的，因为它可能包含图像的“ 29”。然后，我们获得获取图形基元和指令中所述的所有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+(B-A)u, A+(B-A)v}是包含在三角形T中的线段。在实现lineInTri时，需要注意that38ѭ线不是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，那么我们将该数字设为零，因此对1也是一样。我要在这里介绍的另一个方面是，如果要显示的细分中相对较小的部分，则很可能需要删除它。例如，如果我们有{{0,.5}, {.500000000001}}，这意味着我们需要抽奖{{.5, .500000000001}}。但是这个段很小，甚至在大的线段中也没有特别注意，因为我们都知道这两个数字是相同的。在实现ѭ71时，必须考虑所有这些因素。现在，我们准备查看需要从线段中删除的内容。下一个需要从“ 9”生成的对象的列表，该列表中的对象和索引。

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中删除的部分。我们知道ѭ27是三角形，直线和颜色的列表，我们知道列表中索引较高的对象将在索引较低的对象的顶部绘制。因此，我们需要索引start。这是我们将开始在obj中寻找三角形的索引。一旦找到一个三角形，我们将使用函数lineInTri获得位于三角形中的线段部分。最后，我们将获得一个章节列表，可以使用ѭ71进行组合。最后，我们到达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为None时，不渲染多边形。我不确定用网格线可以做到这一点。

要回复问题请先登录或注册

Mathematica：3D线框

2 个回复

发起人

wolfram_mathematica

plot

wireframe

mathematica_8

问题状态

Mathematica：3D线框

与内容相关的链接

2 个回复

发起人

wolfram_mathematica

plot

wireframe

mathematica_8

问题状态