Finding points located in a specific locations of a 3D objects

Question

I have the following list of points in 3D and would like to find the points which are located on the lower edge of the object and on (or closest distance to) the X-Y or Y-Z plane of the symmetry. (Please see yellow points in fig 1). What I did was generating a point which has the X average with Y and Z min and then finding a point of the list which has the closest distance to the generated point. However, it was not correct as the generated point was not a member of the list point so the closest point was sometimes in the front and sometimes on the back of the object for different lists of points.

https://pastebin.com/L12n0Gfr

Answer 1

This is a little involved but I hope you can follow this step-by-step:

(* load the data *)
Evaluate[ToExpression@Import["data3d.txt"]];

(* get the centroid and the KLDecomposition *)
kld = KarhunenLoeveDecomposition[Transpose[Data3D]];

(* get the transformed points, new basis, and new centroid *)
transformed = Transpose[kld[[1]]];
basis = kld[[2]];
trcentr = Mean[transformed];
(* offset to {0,0,0} *)
transformed = (# - trcentr) & /@ transformed;

(* create some planes *)
xyplane = InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 1, 0}}];
xzplane = InfinitePlane[{0, 0, 0}, {{1, 0, 0}, {0, 0, 1}}];
yzplane = InfinitePlane[{0, 0, 0}, {{0, 1, 0}, {0, 0, 1}}];

(* find the points near to each plane, and of those points find the one lowest down *)
yzclosepoints = Select[transformed, RegionDistance[yzplane, #] < 0.5 &];
yzsmallestz = First@MinimalBy[yzclosepoints, Last];
xzclosepoints = Select[transformed, RegionDistance[xzplane, #] < 0.5 &];
xzsmallestz = First@MinimalBy[xzclosepoints, Last];

(* show the transformed points, the planes, the points near the planes *)
Show[
 ListPointPlot3D[transformed, PlotRange -> Full, BoxRatios -> 1, PlotStyle -> Black],
 Graphics3D[{Opacity[.1], Red, xyplane, Green, xzplane, Blue, yzplane}], 
 Graphics3D[{
   Blue, Point[yzclosepoints],
   Darker@Green, Point[xzclosepoints],
   Orange, PointSize[Large],
   Point[yzsmallestz], Point[xzsmallestz]}]
 ]

We now have the desired points but we need to transform them back into the original space:

invkld = Inverse[basis];
untransform[point_] := invkld.(point + trcentr)

(* show the two points in the original space *)
Show[ListPointPlot3D[Data3D], 
 Graphics3D[{Red, PointSize[Large],
   Point[untransform[yzsmallestz]], 
   Point[untransform[xzsmallestz]]
 }]]