9
$\begingroup$

I am trying to "smoothen" meshes. For example, if starting from a cuboid, I would like something similar to a rounded cuboid. There are many ways to smoothen a surface, but I am not going to give a precise definition because I'll be happy with most things that could be qualitatively described as smoothened. It is not a problem if the mesh size changes during the procedure.

How can I smoothen a surface mesh?

So what have I done so far and what's wrong with it?

I tried taking every vertex of the mesh and replacing its coordinates with the average of its neighbours. You'll find an implementation below (iter). The problem with this approach is that it makes some shapes more jagged instead of smoother.

E.g. if I discretize a sphere with Mathematica, then smoothen it, then a clearly icosahedral structure emerges. I need the sphere to remain a sphere, or at least not to expose any recognizable regular geometry.

mesh = DiscretizeRegion[RegionBoundary@Ball[]];
smoothenedMesh = Nest[iter, mesh, 150];
{mesh, smoothenedMesh}

enter image description here

The icosahedral structure is not that obvious on a static screenshot, but it becomes very clear once you start rotating it interactively. This is not acceptable because my goal is precisely to try to destroy geometric regularities that can be perceived visually.

meshQ[_?MeshRegionQ] := True
meshQ[_?BoundaryMeshRegionQ] := True
meshQ[_] := False

MeshToGraph[mesh_?meshQ] :=
    Graph[Developer`ToPackedArray@MeshCells[mesh, 0][[All, 1]],
      Developer`ToPackedArray@MeshCells[mesh, 1][[All, 1]],
      EdgeWeight -> PropertyValue[{mesh, 1}, MeshCellMeasure],
      VertexCoordinates -> MeshCoordinates[mesh]
    ]

iter[mesh_] := Module[{g, coord, newcoord},
  g = MeshToGraph[mesh];
  coord = MeshCoordinates[mesh];
  newcoord = Mean[coord[[AdjacencyList[g, #]]]] & /@ VertexList[g];
  MeshRegion[newcoord, MeshCells[mesh, 2]]
  ]

Here are some test surfaces which may expose other flaws in a smoothening approach.

Graphics3D[
 balls = Table[Ball[RandomReal[1, 3], RandomReal[{0.2, 0.5}]], {20}]
 ]

mesh1 = DiscretizeRegion[
   RegionBoundary[RegionUnion @@ balls],
   MaxCellMeasure -> {2 -> 0.005}
  ]

mesh2 = DiscretizeRegion[
   DiscretizeRegion[RegionBoundary@Cuboid[], 
    MaxCellMeasure -> Infinity], MaxCellMeasure -> {2 -> 0.01}, 
   PlotTheme -> "Default"];

mesh3 = DiscretizeRegion@RegionBoundary@RegionUnion[Cuboid[], Cone[]]

mesh1 should produce an amoeba-like shapeless thing when smoothened. It should not have any sharp or pointy parts.

mesh2 exposes another flaw in my approach: take a look at the corners after smoothening. This however looks more fixable by incremental improvements to the method than the problem I described in the main part of the question.

mesh3 is just another test surface.

Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ Ah, you've rediscovered the problem with naïve Laplacian smoothing (see slides 28-30). The standard solution is to use cotangent weights (slide 34). $\endgroup$
    – user484
    Nov 2, 2016 at 23:02
  • 1
    $\begingroup$ Also, sorry for eavesdropping on your chat, but if you're looking for ways to make smooth blobby shapes in 3D you could consider this previous question. $\endgroup$
    – user484
    Nov 2, 2016 at 23:07
  • $\begingroup$ @Rahul Thanks for both links, very useful! I'll check them out in the morning. The blobby shape is just one of the things I need to make, so I could still use smoothing and your first link looks useful for that $\endgroup$
    – Szabolcs
    Nov 2, 2016 at 23:39

3 Answers 3

Reset to default
7
$\begingroup$

In my opinion this question isn't 'well enough' defined, but is this something you're after?

Essentially I plot the iso-surfaces of a certain distance in order to smoothen the mesh, then rescale to the original mesh's bounding box.

smoothMesh[mesh_?MeshRegionQ, fac_:0.25, outer_:True, pp_:Automatic] /; RegionEmbeddingDimension[mesh] == 3 && RegionDimension[mesh] == 2 :=
  Module[{df, ir, isosurfs, surf},
    df = RegionDistance[mesh];
    ir = ImplicitRegion[df[{x, y, z}] == fac, {x, y, z}];
    isosurfs = DiscretizeRegion[ir, # + {-2fac, 2fac}& /@ RegionBounds[mesh], Method -> {Automatic, PlotPoints -> pp}];
    surf = First[If[TrueQ[outer], MaximalBy, MinimalBy][ConnectedMeshComponents[isosurfs], Area]];
    RegionResize[surf, RegionBounds[mesh]]
  ]

smoothMesh[mesh2]

enter image description here

(* the high PlotPoints setting makes this slow... *)
smoothMesh[mesh1, 0.1, False, 100]

enter image description here

Since mesh1 was randomly generated, here's what it looked like before smoothing:

enter image description here

Let me know if this is or isn't what you were wanting.

Improve this answer
$\endgroup$
5
  • $\begingroup$ I know the question isn't precise but that's because the problem isn't precise either. Most things that "look like smoothing" will be acceptable for my purposes. This works well. Rescaling isn't actually needed, I don't mind if the size changes. $\endgroup$
    – Szabolcs
    Nov 2, 2016 at 18:29
  • $\begingroup$ Ok, great to hear! $\endgroup$
    – Greg Hurst
    Nov 2, 2016 at 18:38
  • $\begingroup$ This solution is a bit ad-hoc though because the inner and outer surfaces give different solutions and it's up to the user to choose the best one. $\endgroup$
    – Greg Hurst
    Nov 2, 2016 at 18:39
  • $\begingroup$ Sorry for being vague about what this is for. It's complicated to explain. If you're really interested, I can explain in chat. $\endgroup$
    – Szabolcs
    Nov 2, 2016 at 18:39
  • $\begingroup$ Sure, that works for me. $\endgroup$
    – Greg Hurst
    Nov 2, 2016 at 18:40
7
$\begingroup$

I've just finished an implementation of the mean curvature flow and I'd like to give some examples of what it can do for you:

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh1, 4]

enter image description here

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh2, 4]

enter image description here

 NestList[MeanCurvatureFlow[#, 3, 0.0025, 0.8] &, mesh3, 4]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Your code give me graphics and additionally I have a error messages Increment::rvalue: c is not a variable with a value, so its value cannot be changed. c++ c++ c++ c++ on my Mathematica 11.3. $\endgroup$
    – Mariusz Iwaniuk
    May 5, 2018 at 9:13
  • $\begingroup$ @MariuszIwaniuk Uh, sorry for the inconvenience. I used GraphicsRow just for display but I realize that this was misleading. The Print[c++] was some debugging code. I removed both. Thanks for pointing that out! $\endgroup$
    – Henrik Schumacher
    May 5, 2018 at 9:26
  • $\begingroup$ Thanks for update. :) $\endgroup$
    – Mariusz Iwaniuk
    May 5, 2018 at 9:38
4
$\begingroup$

I don't have a perfect answer but I will give it a try.

When I apply the function LoopSubdivide from this post to your examples, the results are as follows

NestList[LoopSubdivide, mesh1, 2]

enter image description here

NestList[LoopSubdivide, mesh2, 3]

enter image description here

NestList[LoopSubdivide, mesh3, 3]

enter image description here

As I said, it's not perfect. The issue is that the creases of the initial surfaces are not too clean. The cube would get rounder if the initial mesh was coarser (and a bit more regular).

Improve this answer
$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.