【问题标题】:Modifying a Graphics3D object generated by ParametricPlot3D修改由 ParametricPlot3D 生成的 Graphics3D 对象
【发布时间】:2011-10-06 14:44:43
【问题描述】:

这是一组结构化的3D points。现在我们可以将这些点作为结点形成BSpline

dat=Import["3DFoil.mat", "Data"]
fu=BSplineFunction[dat]

在这里我们可以用这些点做一个ParametricPlot3D

pic=ParametricPlot3D[fu[u,v],{u, 0, 1}, {v, 0, 1}, Mesh -> All, AspectRatio -> 
Automatic,PlotPoints->10,Boxed-> False,Axes-> False]

问题

如果我们仔细观察从样条曲线出来的 3D 几何图形,我们会发现它是一个空心结构。该孔出现在对称轮廓的两侧。我们怎样才能完美地(不是在视觉上!)填补这个洞并创建一个统一的Graphics3D 对象,其中两边的洞都被修补了。

到目前为止,我能得到的是以下内容。孔没有完全修补。

我最近问了太多问题,对此我深表歉意。但如果你们中的任何人感兴趣,我希望你们能提供帮助。

更新

这是belisarius方法的问题。 它生成的三角形面积几乎可以忽略不计。

dat = Import[NotebookDirectory[] <> "/3DFoil.mat", "Data"];
(*With your points in "dat"*)
fd = First@Dimensions@dat;
check = ParametricPlot3D[{BSplineFunction[dat][u, v], 
BSplineFunction[{dat[[1]], Reverse@dat[[1]]}][u, v], 
BSplineFunction[{dat[[fd]], Reverse@dat[[fd]]}][u, v]}, {u, 0, 
1}, {v, 0, 1}, Mesh -> All, AspectRatio -> Automatic, 
PlotPoints -> 10, Boxed -> False, Axes -> False]

输出在这里

Export[NotebookDirectory[]<>"myres.obj",check];
cd=Import[NotebookDirectory[]<>"myres.obj"];
middle=
check[[1]][[2]][[1]][[1(* Here are the numbers of different Graphics group*)]][[2,1,1,1]];
sidePatch1=check[[1]][[2]][[1]][[2]][[2,1,1,1]];
sidePatch2=check[[1]][[2]][[1]][[3]][[2,1,1,1]];

共有三个Graphics 组,其余为空。现在让我们看看这些组中三角形的面积。

polygonArea[pts_List?
(Length[#]==3&)]:=Norm[Cross[pts[[2]]-pts[[1]],pts[[3]]-pts[[1]]]]/2
TriangleMaker[{a_,b_,c_}]:={vertices[[a]],vertices[[b]],vertices[[c]]}
tring=Map[polygonArea[TriangleMaker[#]]&,middle];
tring//Min

对于中间大组输出是

0.000228007

因此这是一个允许的三角测量。但是对于侧面补丁,我们得到零区域。

Map[polygonArea[TriangleMaker[#]] &, sidePatch1] // Min
Map[polygonArea[TriangleMaker[#]] &, sidePatch2] // Min

贝利撒留有什么办法吗?

我的部分解决方案

首先从Wolfram archive下载复杂多边形简化包。

fu = BSplineFunction[dat];
pic =(*ParametricPlot3D[fu[u,v],{u,0,1},{v,0,1},Mesh->None,
AspectRatio->Automatic,PlotPoints->25,Boxed->False,Axes->False,
BoundaryStyle->Red]*)
ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None, 
AspectRatio -> Automatic, PlotPoints -> 10, Boxed -> False, 
Axes -> False, BoundaryStyle -> Black];
bound = First@Cases[Normal[pic], Line[pts_] :> pts, Infinity];
corners = Flatten[Table[fu[u, v], {u, 0, 1}, {v, 0, 1}], 1];
nf = Nearest[bound -> Automatic]; {a1, a2} = 
Union@Flatten@(nf /@ corners);
sets = {bound[[2 ;; a1]], bound[[a1 ;; a2]],bound[[a2 ;; a2 + a1]]};
CorrectOneNodeNumber = Polygon[sets[[{1, 3}]]][[1]][[1]] // Length;
CorrectOneNodes1 = 
Polygon[sets[[{1, 3}]]][[1]][[1]]; CorrectOneNodes2 = 
Take[Polygon[sets[[{1, 3}]]][[1]][[2]], CorrectOneNodeNumber];
<< PolygonTriangulation`SimplePolygonTriangulation`
ver1 = CorrectOneNodes1;
ver2 = CorrectOneNodes2;
triang1 = SimplePolygonTriangulation3D[ver1];
triang2 = SimplePolygonTriangulation3D[ver2];
Show[Graphics3D[{PointSize[Large], Point[CorrectOneNodes1]},Boxed -> False,
BoxRatios -> 1], Graphics3D[{PointSize[Large], Point[CorrectOneNodes2]},
Boxed -> False, BoxRatios -> 1],
Graphics3D[GraphicsComplex[ver1, Polygon[triang1]], Boxed -> False,
BoxRatios -> 1],
Graphics3D[GraphicsComplex[ver2, Polygon[triang2]], Boxed -> False,
BoxRatios -> 1]]

我们在这里得到漂亮的三角形。

picfin=ParametricPlot3D[fu[u,v],{u,0,1},  {v,0,1},Mesh->All,AspectRatio->Automatic,PlotPoints->10,Boxed->False,Axes->False,BoundaryStyle->None];pic3D=Show[Graphics3D[GraphicsComplex[ver1,Polygon[triang1]]],picfin,Graphics3D[GraphicsComplex[ver2,Polygon[triang2]]],Boxed->False,Axes->False]

现在这只有一个问题。无论PlotPoints 是什么,这里总是出现四个三角形,它们与任何其他相邻三角形仅共享一条边。但我们希望所有三角形与其他三角形共享至少两条边。如果我们使用贝利撒留方法,就会发生这种情况。但它创建的三角形太小,我的面板求解器将其拒绝为零面积的刺痛。

可以在这里检查我的方法的问题。这里我们将使用Sjoerd解决方案中的方法。

Export[NotebookDirectory[]<>"myres.obj",pic3D];
cd=Import[NotebookDirectory[]<>"myres.obj"];
polygons=(cd[[1]][[2]]/.GraphicsComplex-> List)[[2]][[1]][[1,1]];
pt=(cd[[1]][[2]]/.GraphicsComplex-> List)[[1]];
vertices=pt;
(*Split every triangle in 3 edges,with nodes in each edge sorted*)
triangleEdges=(Sort/@Subsets[#,{2}])&/@polygons;
(*Generate a list of edges*)
singleEdges=Union[Flatten[triangleEdges,1]];
(*Define a function which,given an edge (node number list),returns the bordering*)
(*triangle numbers.It's done by working through each of the triangles' edges*)
ClearAll[edgesNeighbors]
edgesNeighbors[_]={};
MapIndexed[(edgesNeighbors[#1[[1]]]=Flatten[{edgesNeighbors[#1[[1]]],#2[[1]]}];
edgesNeighbors[#1[[2]]]=Flatten[{edgesNeighbors[#1[[2]]],#2[[1]]}];
edgesNeighbors[#1[[3]]]=Flatten[{edgesNeighbors[#1[[3]]],#2[[1]]}];)&,triangleEdges];

(*Build a triangle relation table.Each'1' indicates a triangle relation*)
relations=ConstantArray[0,{triangleEdges//Length,triangleEdges//Length}];
Scan[(n=edgesNeighbors[##];
If[Length[n]==2,{n1,n2}=n;
relations[[n1,n2]]=1;relations[[n2,n1]]=1];)&,singleEdges]
(*Build a neighborhood list*)
triangleNeigbours=Table[Flatten[Position[relations[[i]],1]],{i,triangleEdges//Length}];
trires=Table[Flatten[{polygons[[i]],triangleNeigbours[[i]]}],{i,1,Length@polygons}];
Cases[Cases[trires,x_:>Length[x]],4]

输出显示总是有四个三角形只与其他三角形共享一条边。

{4,4,4,4}

在贝利撒留方法的情况下,我们看不到这种情况发生,但我们会得到面积为零的三角形。

BR

【问题讨论】:

  • 看看reference.wolfram.com/mathematica/TetGenLink/tutorial/…。它是为这类事情而设计的
  • @belisarius 我用过 TetGenLink 但它不是为此而生的。它制作四面体实体网格。我需要一个表面网格。我实际上想使用 Mathematica 生成的表面网格。但需要得到一个由 Graphics3D 或 GraphicsComplex 定义的实体。我已经编写了代码来完成其余的工作。它运作良好。但在这里我不能首先修补这个洞。最后,TetGen 不是解决方案。
  • 如果您(例如)只有四个顶点,您如何获得all of the triangles to share at least two edges with other triangles 的解决方案?

标签: wolfram-mathematica


【解决方案1】:

导入数据,和之前一样构造BSpline函数:

dat = Import["Downloads/3DFoil.mat", "Data"];

fu = BSplineFunction[dat]

生成曲面,确保包含(仅)边界线,该边界线将跟随曲面的边缘。确保将Mesh 设置为AllNone

pic = ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None, 
  AspectRatio -> Automatic, PlotPoints -> 10, Boxed -> False, 
  Axes -> False, BoundaryStyle -> Red]

从边界线上提取点:

bound = First@Cases[Normal[pic], Line[pts_] :> pts, Infinity]

根据您的参数空间找到“角落”:

corners = Flatten[Table[fu[u, v], {u, 0, 1}, {v, 0, 1}], 1]

找到与角最对应的边缘点,记住ParametricPlot3D 并没有完全使用限制,所以我们不能只使用Position

nf = Nearest[bound -> Automatic];
nf /@ corners

找出边界上的哪些点范围对应于您需要填充的区域。此步骤涉及一些人工检查。

sets = {bound[[2 ;; 22]], bound[[22 ;; 52]], bound[[52 ;; 72]], 
  bound[[72 ;;]]}

构造与孔对应的新多边形:

Graphics3D[Polygon[sets[[{1, 3}]]], Boxed -> False, BoxRatios -> 1]

Show[pic, Graphics3D[Polygon[sets[[{1, 3}]]]]]

请注意,您提到的孔之间的边缘可能仍然有一个看不到的孔,我还没有尝试填充它,但如果需要,您应该有足够的信息来做到这一点。

【讨论】:

  • nf /@ corners 返回 {{22},{22},{52},{52}} 并且您可以从中找到sets = {bound[[2 ;; 22]], bound[[22 ;; 52]], bound[[52 ;; 72]], bound[[72 ;;]]} 的逻辑是什么?我不能得到这个。无论如何,它仍然非常有帮助,我需要摆脱“手动检查”。我会试试的。。
  • @plato 在这种情况下,两端都具有大致相同的 z 值,这可能对您有所概括。在这种情况下,我最初使用了;;2222;;5252;;,但它包含的太多了。我抛弃了第一点,并根据它可能是对称的(足够)的想法使第三段长度相同。
【解决方案2】:

您的数据集如下所示:

Graphics3D[Point@Flatten[dat, 1]]

由 22 个部分组成,共 50 个点。

在每个末端部分添加一条中线(实际上是将末端部分展平):

dat2 = Append[Prepend[dat, 
                      Table[(dat[[1, i]] + dat[[1, -i]])/2, {i, Length[dat[[1]]]}]
              ], 
              Table[(dat[[-1, i]] + dat[[-1, -i]])/2, {i, Length[dat[[-1]]]}]
       ];

Graphics3D[{Point@Flatten[dat, 1], Red, Point@dat2[[1]], Green, Point@dat2[[-1]]}]

现在为翼尖边缘添加一些权重:

sw = Table[1, {24}, {50}];
sw[[2]] = 1000 sw[[1]];
sw[[-2]] = 1000 sw[[1]];
fu = BSplineFunction[dat2, SplineWeights -> sw];

Show[
  ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> All, 
                      AspectRatio -> Automatic, PlotPoints -> 20, Boxed -> False, 
                      Axes -> False, Lighting -> "Neutral"
  ], 
  Graphics3D[{PointSize -> 0.025, Green, Point@dat2[[-1]], Red,Point@dat2[[-2]]}]
]

请注意,我将 PlotPoints 的值增加到 20。

【讨论】:

    【解决方案3】:
    (*With your points in "dat"*)
    fu = BSplineFunction[dat[[1 ;; 2]]];
    Show[{ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, 
                          Mesh -> All, AspectRatio -> Automatic, PlotPoints -> 30], 
          ListPlot3D[dat[[1]]]}]
    

    InputForm[%]
    

    你得到了“统一”的图形对象。

    编辑

    另一种方式,可能更好:

    (*With your points in "dat"*)
    fu = BSplineFunction[dat];
    Show[
    
    { ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, 
                           Mesh -> All, AspectRatio -> Automatic, 
                           PlotPoints -> 10, Boxed -> False, Axes -> False], 
      ParametricPlot3D[
       BSplineFunction[{First@dat, Reverse@First@dat}][u, v], {u, 0, 1}, {v, 0, 1},
                        Mesh -> None, PlotStyle -> Yellow], 
      ParametricPlot3D[
       BSplineFunction[{dat[[First@Dimensions@dat]],
                        Reverse@dat[[First@Dimensions@dat]]}]
                        [u, v], {u, 0, 1}, {v, 0, 1}]}]
    

    只有一个结构:

    (*With your points in "dat"*)
    fd = First@Dimensions@dat;
    ParametricPlot3D[
     {BSplineFunction[dat][u, v],
      BSplineFunction[{dat[[1]],  Reverse@dat[[1]]}] [u, v],
      BSplineFunction[{dat[[fd]], Reverse@dat[[fd]]}][u, v]},
     {u, 0, 1}, {v, 0, 1},
     Mesh -> All, AspectRatio -> Automatic,
     PlotPoints -> 10, Boxed -> False, Axes -> False]
    

    编辑

    您可以检查是否有小三角形,但它们确实是三角形而不是零面积多边形:

    fu = BSplineFunction[dat];
    check = ParametricPlot3D[{BSplineFunction[{First@dat, Reverse@dat[[1]]}][u, v]}, 
                             {u, 0, 1}, {v, 0, 1}, Mesh -> All, 
                             PlotStyle -> Yellow, Mesh -> All, AspectRatio -> Automatic, 
                             PlotPoints -> 10, Boxed -> False, Axes -> False];
    pts = check /. Graphics3D[GraphicsComplex[a_, b__], ___] -> a;
    m = check[[1]][[2]][[1]][[1]] /. {___, GraphicsGroup[{Polygon[a_]}]} -> a;
    t = Replace[m, {a_, b_, c_} -> {pts[[a]], pts[[b]], pts[[c]]}, {1}];
    polygonArea[pts_List?(Length[#] == 3 &)] := 
                                     Norm[Cross[pts[[2]] - pts[[1]], pts[[3]] - pts[[1]]]]/2;
    
    t[[Position[Ordering[polygonArea /@ t], 1][[1]]]]
    
    (*
    ->{{{-4.93236, 0.0989696, -2.91748}, 
        {-4.92674, 0.0990546, -2.91748}, 
        {-4.93456, 0.100181, -2.91748}}}
    *)
    

    【讨论】:

    • 我更新了我的问题。看看你是否对那些面积为零的三角形有一些想法。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-06-09
    • 1970-01-01
    • 2015-02-13
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多