Mdthbs

How to mesh a volume (3D region) with nearly equaly spaced vertices?

Example: Disk with radius 50 and height 15

disk = ImplicitRegion[0 < x^2 + y^2 < 50^2 && 0 < z < 15, {x, y, z}];

Is there an easy way to mesh the volume such that the vertices are constrained to around 5?

I tried

ToElementMesh[disk, MaxCellMeasure -> {1 ->100}]["Wireframe"]

which only gives a nonuniform mesh

Thanks!

Here is a possible way forward. I think the standard meshing algorithm attempt to give you a good circular boundary and then this dictates a general mesh size which is too fine for your purposes. Here I define my own boundary points and then mesh from there. I have your five vertices across the disk thickness and put a similar spacing around the circumference.

   Needs["NDSolve`FEM`"]

 h = 15; (* height *)

    r = 50; (* radius *)

    nn = 79; (* number of edges *)

    pts = Partition[Flatten[Table[

        Table[{r Cos[2 π k/nn], r Sin[2 π k/nn], z}, {k, 0, 

          nn - 1}],

        {z, 0, h, h/4}]], 3];

    Graphics3D[{

      Point[pts]

      }



 ]

Now I make the boundary mesh which is not fine.

m = DelaunayMesh[pts];

bmesh = ToBoundaryMesh[m];

bmesh["Wireframe"]

Now the mesh density seems to follow from the boundary

mesh = ToElementMesh[bmesh];

mesh["Wireframe"]

I don't know how to best check the mesh size within the boundaries. Perhaps someone can suggest a method. Here is a section showing the nodes. There are mid side nodes on each tetrahedra but I think I have your 5 vertices across the thickness.

cc = mesh["Coordinates"];

Show[

 Graphics3D[Point[cc], PlotRange -> {All, {0, 10}, All}],

 mesh["Wireframe"]

 ]

Also we can look at the mesh quality

Histogram[mesh["Quality"]]

The histogram suggests that there is a dominant size around 0.8. I am not sure of the units here. Is the horizontal axis the volume of elements?

Does this help?

Coarse cylinder

Using the Cylinder primitive seems to do the trick:

MeshRegion[

  DiscretizeRegion[Cylinder[{{0, 0, 0}, {0, 0, 15}}, 50], MaxCellMeasure -> {1 -> 100}], 

  PlotTheme -> "Lines", 

  MeshCellStyle -> {1 -> Black}

]

General region

Notice that the boundary is being discretized finer than you'd like. It looks like if we can workaround this, we could get a coarse mesh with higher quality elements.

One way is through stricter sampling options:

cyl = ImplicitRegion[0 < x^2 + y^2 < 50^2 && 0 < z < 15, {x, y, z}];

mr = DiscretizeRegion[cyl, 

  MaxCellMeasure -> {1 -> 100, 3 -> 200}, 

  Method -> {"RegionPlot3D", PlotPoints -> 6}

];



MeshCellCount[mr]

{386, 1990, 2902, 1297}

MeshRegion[mr, PlotTheme -> "Lines", MeshCellStyle -> {1 -> Black}]

Histogram[PropertyValue[{mr, 3}, MeshCellQuality]]

Here's another example:

ball = ImplicitRegion[x^2 + y^2 + z^2 <= 50^2, {x, y, z}];



mr1 = DiscretizeRegion[ball, MaxCellMeasure -> {1 -> 100}];

mr2 = DiscretizeRegion[ball, MaxCellMeasure -> {1 -> 100, 3 -> 200}, 

  Method -> {"RegionPlot3D", PlotPoints -> 6}];



MeshRegion[mr1, PlotTheme -> "Lines", MeshCellStyle -> {1 -> Black}]

MeshRegion[mr2, PlotTheme -> "Lines", MeshCellStyle -> {1 -> Black}]

Histogram[PropertyValue[{mr1, 3}, MeshCellQuality]]

Histogram[PropertyValue[{mr2, 3}, MeshCellQuality]]