修改ParametricPlot3D生成的Graphics3D对象

Pla*_*iac 5 wolfram-mathematica

这是一组结构化的3D点.现在我们可以形成一个BSpline使用这些点作为结.

dat=Import["3DFoil.mat", "Data"]
fu=BSplineFunction[dat]
Run Code Online (Sandbox Code Playgroud)

在这里,我们可以ParametricPlot3D用这些点来做.

pic=ParametricPlot3D[fu[u,v],{u, 0, 1}, {v, 0, 1}, Mesh -> All, AspectRatio -> 
Automatic,PlotPoints->10,Boxed-> False,Axes-> False]
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

如果我们仔细观察从样条曲线出来的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]
Run Code Online (Sandbox Code Playgroud)

输出在这里 在此输入图像描述

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]];
Run Code Online (Sandbox Code Playgroud)

有三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
Run Code Online (Sandbox Code Playgroud)

对于中间的大组输出是

0.000228007
Run Code Online (Sandbox Code Playgroud)

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

Map[polygonArea[TriangleMaker[#]] &, sidePatch1] // Min
Map[polygonArea[TriangleMaker[#]] &, sidePatch2] // Min
Run Code Online (Sandbox Code Playgroud)

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]]
Run Code Online (Sandbox Code Playgroud)

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

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]
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述 在此输入图像描述

现在这只有一个问题.这里不论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]
Run Code Online (Sandbox Code Playgroud)

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

{4,4,4,4}
Run Code Online (Sandbox Code Playgroud)

在belisarius方法的情况下,我们看不到这种情况,但是我们得到的数字为零的三角形区域.

BR

Sjo*_*ies 3

您的数据集如下所示:

Graphics3D[Point@Flatten[dat, 1]]
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

它由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]]}]
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

现在向翼尖边缘添加一些重量:

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]]}]
]
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

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