Reduce quality of an imported MeshRegion

Question

Importing STL files using Import results in a MeshRegion composed by the triangulation of the original file, and a similar ByteCount as the file in disk.

When trying to render interactive graphics using Manipulate, the time needed to render the visualization of the object is very high, not being able to be done in real time.

Is there a way to reduce the quality/size of the MeshRegion within Mathematica to reduce the size of the object and improve Manipulation speed?

I have tried using DiscretizeRegion and DiscretizeGraphics on the imported object, but it seems it does not work on MeshRegion.

I would like to find a way to do this in Mathematica, without having to rely on a CAD program to import and export the file again with a lower triangulation quality.

EDIT:

Here is an example of an object:

The STL file can be downloaded here: STL file

Answer 1

Decimation of mesh is not a trivial task if you want to preserve the visual features of the original mesh. If you want to tap into the efforts of people that have been working on the problem for many years, you could use the freely available MeshLab to perform the decimation with a script driven from Mathematica. Here is one possible workflow (Note: Uncompress to see the underlying MeshLab mlx script that drives the decimation):

SetDirectory[NotebookDirectory[]];
createDeciScript[deci_ : 0.1] := 
 StringTemplate[
   Uncompress[Import["https://pastebin.com/raw/Fsu2RNLt", "Text"]]][<|
   "d" -> deci|>]
fileName = "deci.mlx";
file = OpenWrite[fileName];
WriteString[file, createDeciScript[0.1]];
Close[file];
cmd = "\"C:\\Program Files\\VCG\\MeshLab\\meshlabserver.exe\" -i \
Link.stl -o LinkDeci.stl -s deci.mlx -om";
Run[cmd];
{stl, stlDeci} = {Import["Link.stl"], Import["LinkDeci.stl"]}

The image on the right has 10x fewer triangles than the image on the left.

Answer 2

Well... (importing your .STL object):

obj = Import["Link.STL"]

...if nothing else a very poor man's solution for simple visual in an interactive interface is just random sampling of points (i know it is far from spectacular :-) but is very light):

pts=RandomPoint[obj,1000];
obj//ByteCount
Graphics3D[Point[pts]]//ByteCount

1808792

24792

Also I just would like to outline a strategy for this, and explain why it might be a good approach. I cannot run complete wonderful code by @HenrikSchumacher (tech difficulties), but people here I bet can figure it out. So now if we think of somehow roughening polygons to lower resolution we might run into a problem, depending on a case, and this case is a good example. Let's see how points are distributed in the original .STL object:

Graphics3D[MeshPrimitives[obj, 0]]

Do you see how many are dense in one region and sparse in another? So some blunt approach of locally down-sampling polygons might require a very complicated algorithm, but still be inefficient somehow due to highly non-uniform down-sampling. Now we can think of another approach. We have ability to randomly point-sample any high-res region:

pts=RandomPoint[obj,200];

and you can see how points now appear in the regions with low density of points in the original mesh:

Show[
    HighlightMesh[RegionBoundary[obj],{Style[2,Opacity[0.2]],Style[1,Opacity[0.4]]}],
    Graphics3D[{Red,Sphere[pts,1]}],
Boxed->True,Axes->True]

Now you can run wonderful code by @HenrikSchumacher and others seen in posts about VORONOI and GEODESICS to be ready to go, or maybe you can also think of applying a spline approach as an interesting alternative discussed HERE - but this might need more jumping through the hoops in terms of proper data for BSplineFunction.

Answer 3

I have been trying to do this calculating a Concave Hull using this approach:

obj = Import["Link.STL"];
pts = RandomPoint[obj, 10000];
tetrahedra = Level[MeshPrimitives[DelaunayMesh[pts], 3], {-3}];
radius[p_] := Check[Circumsphere[p][[2]], 10000];
radii = radius /@ tetrahedra;
alphashape[rmax_] := Pick[tetrahedra, radii, r_ /; r < rmax]
faces[tetras_] := Flatten[
   tetras /. {a_, b_, c_, d_} :> {{a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}}, 1];
externalfaces[faces_] := Cases[Tally[Sort /@ faces], {face_, 1} :> face];
radiusmax = 50;
polys = externalfaces@faces@alphashape[radiusmax];
Graphics3D[
  {EdgeForm[{Thin, Opacity[1/30, Black]}], Polygon@polys},
  AxesLabel -> {"x", "y", "z"},
  Axes -> True,
  Boxed -> False,
  BoxRatios -> {1, 1, 1},
  ViewPoint -> 1000 {-1, 1, -1}
]

from: https://mathematica.stackexchange.com/a/201558/57063

But it seems to be difficult to modify the radiusmax parameter to obtain detail on edges without causing the hull to have gaps or holes.