Mfcttrf

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