# How to make the ListContourPlot3D smooth and closed?

I am struggling with making my plot in ListContourPlot3D smooth and closed. I have seen so many posts regarding the same issue but in other functions, the solution of which can not be applied to ListContourPlot3D.

I have the following data

https://www.dropbox.com/s/3pfgejjgjmav2cu/H1Data.csv?dl=0

I am using the following command

ListContourPlot3D[H1Data, Mesh -> None, Contours -> {0.01},
PlotRange -> {{0, 25}, {0, 25}, {0, 25}}, ContourStyle -> {Blue}]


The first issue, as I mentioned is that the plot is not smooth and has a rough surface

The second issue concerns closing the surface. If I see the back of the plot it is just like a shell. I would like to make it a closed surface.

I just need to have a smooth closed surface with a constant color (as shown), so it doesn't matter if another function can do the job for me.

We can get better sampling by setting MaxPlotPoints to a relatively large value:

plot = ListContourPlot3D[H1Data, Mesh -> None, Contours -> {0.01},
PlotRange -> {{0, 25}, {0, 25}, {0, 25}}, ContourStyle -> {Blue}, MaxPlotPoints -> 100]


To smooth this plot, we can apply @HenrikSchumacher's GraphDiffusionFlow defined here. I'll work on both components separately to use different parameters.

mr = DiscretizeGraphics[plot];
c1 = First[ConnectedMeshComponents[mr]];
smooth1 = GraphDiffusionFlow[c1, 40, 0.125, .8]


To retain the hard boundary edge in the small part, I'll close it up with ConvexHullMesh.

c2 = Last[ConnectedMeshComponents[mr]];
c2 = RegionBoundary[TriangulateMesh[ConvexHullMesh[MeshCoordinates[c2]]]];
smooth2 = GraphDiffusionFlow[c2, 5, 0.125, 1]


Finally, a simple call to RepairMesh will close up the remaining hole. I will take a longer route though in order to apply smooth shading while avoiding hard edges. Essentially I'll render the model and hole patch separately.

hole = FindMeshDefects[smooth1, "HoleEdges", "Cell"]["HoleEdges"][[1, 1, 1]];
coords = MeshCoordinates[smooth1];
newcoords = ReplacePart[coords, Thread[hole -> Transpose[{0, 1, 1} Transpose[coords[[hole]]]]]];

Show[
MeshRegion[newcoords, MeshCells[smooth1, 2], PlotTheme -> "SmoothShading", BaseStyle -> ColorData[112, 2]],
MeshRegion[newcoords, Polygon[Most[hole]], MeshCellStyle -> {1 -> Black}, BaseStyle -> ColorData[112, 2]],
MeshRegion[smooth2, PlotTheme -> "SmoothShading", BaseStyle -> ColorData[112, 2]],
Axes -> True,
Boxed -> True,
Method -> {"ShrinkWrap" -> False},
PlotRange -> {{0, 25}, {0, 25}, {0, 25}}
]


• A very nice and sophisticated answer. Thanks a lot! Jan 29, 2019 at 8:06
• Just one question remains. As you can ses, there is a very small blue piece on the upper part of the ListContourPlot3D, which after using the function DiscretizeGraphics vanishes. Is it possible to keep that piece? Jan 29, 2019 at 8:23
• Is it possible also to change the color of the final plot? Jan 29, 2019 at 8:30
• Ah, I thought that small part was noise and removed it with ConnectedMeshComponents. I've fixed this and added color in my latest edit. Jan 29, 2019 at 14:11
• Thanks a lot for your complete answer Jan 29, 2019 at 14:14