修改ParametricPlot3D生成的Graphics3D對象

Question

這是一組結構化的3D點 。 現在我們可以使用這些點作為結點形成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

belisarius有什么方法嗎？

我的部分解決方案

首先下載軟件包以簡化Wolfram存檔中的復雜多邊形。

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如何，總會出現四個三角形，它們只與任何其他相鄰三角形共享一條邊 。 但我們希望所有三角形與其他角色共享至少兩條邊。 如果我們使用belisarius方法會發生這種情況。 但它創建了太小的三角形，我的面板求解器拒絕為零區域的帶狀皰疹。

我可以在這里查看我的方法的問題。 在這里，我們將使用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}

在belisarius方法的情況下，我們看不到這種情況，但是我們得到的數字為零的三角形區域。

BR

Answer 1

像以前一樣導入數據並構造BSpline函數：

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

fu = BSplineFunction[dat]

生成曲面，確保包含（僅）邊界線，該邊界線將跟隨曲面的邊緣。 確保將“ Mesh設置為“ All或“ None 。

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}]]]]]

請注意，在您提到的孔之間可能仍然存在無法看到邊緣的孔，我還沒有嘗試填充它，但是如果需要，您應該有足夠的信息來執行此操作。

Answer 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。

Answer 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}}}
*)