Finding lower boundary of a 3D object in list format

Question

I have the following point list and would like to find the points located in the lower boundary of the 3D object (It is part of a body torso).

https://pastebin.com/L12n0Gfr

I am using the following script. However, in the end it shows just one point which is not correct. I think the reason is that the lower boundary points are not aligned with a straight line. Any help is really appreciated.

B3 = Select[data3D, MemberQ[#, Min[ data3D[[All, 2]]]] &];

Answer 1

I think I've found a method that could work. The idea is to make a MeshRegion out of your points and then find all of the polygons with similar face normal vectors. The normal vectors can be computed with MeshCellNormals as described in this answer:

mesh = ConvexHullMesh[Data3D];
poly = MeshPrimitives[ConvexHullMesh[Data3D], 2];
clusters = ClusteringComponents[
   Region`Mesh`MeshCellNormals[mesh, 2],
   Automatic,
   1
];
nClusters = Max[clusters]

6

So now we have all of the polygons and clustered them into groups and we just need to figure out which clusters correspond to the top and bottom of the torso. In my case, it turns out that clusters 1 and 3 are the ones I need:

Show[
 ListPointPlot3D[Data3D],
 Graphics3D[Pick[poly, clusters, 1 | 3]]
]

To get the points defined by these polygons (say, the ones from cluster 1):

pts = Union @@ Pick[poly, clusters, 1][[All, 1]];
Length[pts]

408

Check that these points are all members of Data3D:

Length[Intersection[pts, Data3D]]

408

edit

The OP indicated that there seems to be some issue with the computation of the normals. It's possible that some of the polygons of the mesh are very tiny and the normals cannot be computed or something. The first suggestion I have for this is to try

mesh = RepairMesh[mesh]

to see if that helps. If that doesn't work, it's worth investigating the normals computed:

normals = Region`Mesh`MeshCellNormals[mesh, 2];
Count[normals, Except[{__?NumericQ}]]
Length[normals]

If the number of non-numeric vectors in normals is fairly low, you could consider throwing out the problematic polygons:

goodPolyPos = Flatten @ Position[normals, {__?NumericQ}, {1}, Heads -> False];
normals = normals[[goodPolyPos]];
poly = poly[[goodPolyPos]]

From there you could continue with:

clusters = ClusteringComponents[normals, Automatic, 1];

and see how you get on.