Sửa đổi đối tượng Graphics3D được tạo bởi ParametricPlot3D

Question

Đây là tập hợp các cấu trúc 3D points. Bây giờ chúng ta có thể tạo thành một BSpline sử dụng các điểm này làm nút thắt.

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

Ở đây chúng tôi có thể thực hiện ParametricPlot3D với những điểm này.

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

Câu hỏi

Nếu chúng tôi cẩn thận xem xét các hình học 3D sắp ra của spline chúng ta có thể thấy rằng nó là một cấu trúc rỗng. Lỗ này xuất hiện ở cả hai bên của cấu hình đối xứng. Làm thế nào chúng ta có thể hoàn hảo (không trực quan!) Điền vào lỗ này và tạo ra một đối tượng thống nhất Graphics3D nơi lỗ ở cả hai bên được vá.

gì tôi có thể để có được cho đến nay là như sau. Lỗ không được vá hoàn toàn.

Tôi đang hỏi quá nhiều câu hỏi gần đây và tôi xin lỗi vì điều đó. Nhưng nếu bạn có hứng thú, tôi hy vọng bạn sẽ giúp đỡ.

Cập nhật

Dưới đây là vấn đề với phương pháp Belisarius. Nó tạo ra hình tam giác với các khu vực gần như không đáng kể.

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] 

đầu ra là ở đây

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

Có ba Graphics nhóm nghỉ ngơi là trống rỗng. Bây giờ, hãy xem khu vực tam giác trong các nhóm đó.

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 

Đối với đầu ra nhóm lớn giữa là

0.000228007 

này do đó là một tam giác cho phép. Nhưng đối với các bản vá lỗi bên chúng tôi nhận được không khu vực.

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

Mọi cách thoát ra khỏi đây không?

giải pháp phần My

Đầu tiên tải về các gói cho đơn giản hóa đa giác phức tạp từ 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]] 

Chúng tôi có hình tam giác đẹp ở đây.

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] 

Bây giờ này có chỉ là một vấn đề. Ở đây không phân biệt PlotPoints có bốn hình tam giác luôn xuất hiện chỉ có chỉ chia sẻ một cạnh với bất kỳ hình tam giác lân cận nào khác. Nhưng chúng tôi hy vọng tất cả các hình tam giác sẽ chia sẻ ít nhất hai cạnh với các trang khác. Điều đó xảy ra nếu chúng ta sử dụng phương pháp belisarius. Nhưng nó tạo ra các hình tam giác quá nhỏ mà bộ giải bảng điều khiển của tôi từ chối như là các vùng không có diện tích bằng 0.

Người ta có thể kiểm tra ở đây vấn đề về phương pháp của tôi. Ở đây chúng ta sẽ sử dụng phương thức từ giải pháp bởi 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] 

Hiển thị đầu ra luôn có bốn hình tam giác chỉ chia sẻ một cạnh với các hình tam giác khác.

{4,4,4,4} 

Trong trường hợp phương pháp belisarius chúng tôi không thấy điều này xảy ra nhưng ở đó chúng tôi nhận được hình tam giác với các vùng bằng số không.

BR

Answer 1

bộ dữ liệu của bạn trông như thế này:

Graphics3D[Point@Flatten[dat, 1]] 

Nó bao gồm 22 phần của 50 điểm.

Thêm một dòng giữa trong mỗi phần kết thúc (mà thực sự là phần cuối dẹt):

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

Bây giờ thêm một số trọng lượng để vành ở đầu cánh:

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

Lưu ý rằng tôi đã tăng số PlotPoints giá trị đến 20.

Answer 2

nhập dữ liệu và xây dựng các chức năng BSpline như trước:

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

fu = BSplineFunction[dat] 

Tạo bề mặt, đảm bảo bao gồm (chỉ) là đường biên giới, mà sẽ làm theo các cạnh của bề mặt . Đảm bảo đặt Mesh thành All hoặc None.

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

Giải nén điểm từ dòng ranh giới:

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

Tìm các "góc", dựa trên không gian tham số của bạn:

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

Tìm các điểm cạnh tương ứng tốt nhất để các góc , lưu ý rằng ParametricPlot3D không sử dụng giới hạn chính xác, vì vậy chúng tôi không thể chỉ sử dụng Position:

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

Tìm phạm vi điểm trên ranh giới tương ứng với các khu vực bạn cần lấp đầy. Bước này liên quan đến việc kiểm tra thủ công.

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

Xây dựng đa giác mới tương ứng với các lỗ:

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

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

Lưu ý rằng có lẽ vẫn còn một lỗ mà không thể được nhìn thấy nơi mép chạy giữa các lỗ bạn đề cập đến, và tôi thiên đường' Tôi đã cố gắng điền vào, nhưng bạn nên có đủ thông tin để làm điều đó nếu cần.

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

Và với

InputForm[%] 

bạn nhận được đối tượng đồ họa "thống nhất".

Sửa

Một cách khác, có lẽ tốt hơn:

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

Chỉ trong một cấu trúc:

(*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] 

Sửa

Bạn có thể kiểm tra xem có hình tam giác nhỏ, nhưng họ là tam giác thực sự chứ không phải bằng không đa giác diện tích:

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