2
$\begingroup$

I would like to crop the hexagonal close-packed system as a hexagon and not as a cube. I would like to use the following volumetricPlot already given on this exchange by Jens.

volumetricPlot[latticeType_] := Module[
  {
   img = LatticeData[latticeType, "Image"],
   r = LatticeData[latticeType, "PackingRadius"]
   },
  Show[
   img /. Sphere[pt_, r_] :> {},
   Map[
    RegionPlot3D[(EuclideanDistance[{x, y, z}, #] < r),
      {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
      Mesh -> False,
      PlotStyle -> Opacity[.5]
      ] &, Cases[img, Sphere[pos_, _] :> pos, Infinity]]
   ]
  ]

  volumetricPlot["HexagonalClosePacking"]

However as a newbie to Mathematica I am not sure how to change RegionPlot3D to crop at the hexagon boundaries. Any thoughts?

$\endgroup$

1 Answer 1

5
$\begingroup$

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

hexagon

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

hexagon 3

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.

$\endgroup$
1
  • $\begingroup$ Thank-you!!! This is great. At the moment I am fine with the rough edges and I did see your earlier comment about the incorrect Image part of LatticeData. $\endgroup$
    – user13206
    Commented May 24, 2014 at 22:04

Your Answer

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

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