修改由ParametricPlot3D生成的Graphics3D對象

Question

這是一組結構化的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對象，其中兩側的孔修補。

我能夠弄到什麼如下。孔沒有完全修補。

最近我問了太多問題，我很抱歉。但是如果你們中的任何一位感興趣，我希望你們能幫上忙。

更新

這裏是貝利薩留法的問題。它生成三角形幾乎忽略不計的區域。

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 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總是出現四個三角形，只有與任何其他相鄰三角形共享一條邊。但是我們希望所有的三角形至少與其他小箭頭共享兩個邊。如果我們使用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

你的數據集是這樣的：

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 2

導入數據和構造B樣條函數爲前：

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

注意，有可能是仍然在邊緣你提到的孔之間運行，不能看到一個洞，我的天堂」 t試圖填補它，但如果需要的話，你應該有足夠的信息去做。

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