2
$\begingroup$

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 rough surface of the plot

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.

The surface with open back

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.

Improve this question
$\endgroup$

1 Answer 1

Reset to default
4
$\begingroup$

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]

enter image description here

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]

enter image description here

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]

enter image description here

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}}
]

enter image description here

Improve this answer
$\endgroup$
10
  • $\begingroup$ A very nice and sophisticated answer. Thanks a lot! $\endgroup$
    – KratosMath
    Jan 29, 2019 at 8:06
  • $\begingroup$ 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? $\endgroup$
    – KratosMath
    Jan 29, 2019 at 8:23
  • $\begingroup$ Is it possible also to change the color of the final plot? $\endgroup$
    – KratosMath
    Jan 29, 2019 at 8:30
  • $\begingroup$ Ah, I thought that small part was noise and removed it with ConnectedMeshComponents. I've fixed this and added color in my latest edit. $\endgroup$
    – Greg Hurst
    Jan 29, 2019 at 14:11
  • $\begingroup$ Thanks a lot for your complete answer $\endgroup$
    – KratosMath
    Jan 29, 2019 at 14:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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