The earlier answer that the question refers to is here: Can a LatticeData image be displayed in a space filled fashion.
Edit: a much faster approach is shown at the end
Generalizing the RegionPlot3D
approach to a non-cubic lattice is certainly possible, but it doesn't look as nice because there are always artifacts due to the finite resolution near corners of the constrained surfaces. Here is what it looks like, with a large PlotPoints
setting for RegionPlot3D
- so it's also quite slow to render.
To speed things up I rearranged the RegionPlot3D
so that it is called once for each sphere with its individual plot range set to be a small box of side 2r
around it; and the results are then combined in Show
. This is just a small modification of my earlier answer (linked above).
The main new thing is that I get the hexagonal region by calling PolyhedronData[{"Prism", 6}, "RegionFunction"]
. This way I don't need to write a lot of inequalities to define the borders:
volumetricPlot[latticeType_] := Module[
{pos,
img = LatticeData[latticeType, "Image"],
r = LatticeData[latticeType, "PackingRadius"]},
Show[img /. Sphere[pt_, r_] :> {},
Map[
RegionPlot3D[
(
EuclideanDistance[{x, y, z}, #] < r &&
PolyhedronData[{"Prism", 6}, "RegionFunction"][x, y, 0]),
{x, #[[1]] - r, #[[1]] + r}, {y, #[[2]] - r, #[[2]] +
r}, {z, #[[3]] - r, #[[3]] + r},
PlotPoints -> 30,
Mesh -> False,
PlotStyle -> Opacity[.5]] &,
Cases[img, Sphere[pos_, _] :> pos, Infinity]],
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}]
]
volumetricPlot["HexagonalClosePacking"]
You can see how the hexagonal faces cut off the spheres as desired, but on the other hand the limitations of RegionPlot3D
make the edges appear jagged. Nevertheless, the question was about how to modify the RegionPlot3D
approach, so this is one way to do it.
And of course, the bug I mentioned in the earlier answer still remains: the spheres should be touching but are not doing that at the bottom.
Replacing RegionPlot3d
to get sharper cutoff
Since the RegionPlot3D
wrinkles can't really be removed with any sensible amount of processing time, I would suggest going back to a less "solid" looking approach which however renders the edges much more cleanly. It is based on ContourPlot3D
to draw the spheres:
volumetricPlot[latticeType_] :=
Module[{img = LatticeData[latticeType, "Image"],
r = LatticeData[latticeType, "PackingRadius"]},
Show[img /. Sphere[pt_, r_] :> {},
Map[ContourPlot3D[
(#.#) &[{x, y, z} - #] == r^2, {x, -1, 1}, {y, -1, 1}, {z, -1,
1},
Mesh -> False,
ContourStyle -> Opacity[.5],
RegionFunction -> (PolyhedronData[{"Prism", 6},
"RegionFunction"][#1, #2, 0] &)] &,
Cases[img, Sphere[pos_, _] :> pos, Infinity]]]]
volumetricPlot["HexagonalClosePacking"]
Here you could further improve the smoothness by adding PlotPoints
- the output shown above is for the standard settings, to illustrate that it already works quite well - and really fast by comparison.