Generating and Imaging of the water molecules with Graphics3D

Question

my problem is I don't know how to generate e.g. 20 water molecules:

Graphics3D[
 Rotate[First@ChemicalData["Water", "MoleculePlot"], 
  45 Degree, {8, .5, 0}]]

and I don't know as well how to show them in the figure:

a = 30;
b = 32;
c = -1;
z = -.5;
h = -50 z;
center = 13;
CoolColor[z_] := RGBColor[1 - z, 1 - z, 1];
liquid = Graphics3D[{Opacity[.02], LightBlue, EdgeForm[], 
    Cuboid[{center - a, c - 3, -.5}, {center + a, b + 4, h}]}, 
   Boxed -> False];
bottomSurface = 
  Graphics3D[{Opacity[.3], EdgeForm[], Blue, 
    Cuboid[{center - a, c - 3, -1}, {center + a, b + 4, -.5}]}, 
   Boxed -> False];
topSurface = 
  Graphics3D[{Opacity[.3], EdgeForm[], Blue, 
    Cuboid[{center - a, c - 3, h}, {center + a, b + 4, h + 3}]}, 
   Boxed -> False];
sphere = Graphics3D[{Opacity[.3], Blue, Specularity[White, 5], 
    Sphere[{center, b/2, .82 h}, 3]}, Boxed -> False, 
   Lighting -> "Neutral" ];
cone = {(1 + 4 v) Cos[u], (1 + 4 v) Sin[u], 22.5 + 15 v};
laser = ContourPlot3D[(x - center)^2 + (y - b/2)^2 - (z - .75 h)^2 == 
    11, {x, -10, 40}, {y, -10, 40}, {z, -.5, h + 3}, 
   BoundaryStyle -> None, Mesh -> None, 
   ContourStyle -> 
    Directive[Orange, Opacity[0.6], Specularity[White, 10]]];
line = Graphics3D[{Black, Arrowheads[{{-0.02, 0}, {0.02, .42}}], 
    Arrow[Tube[{{6, b/2, h}, {6, b/2, .82 h}, {12, b/2, .82 h}}, 
      0.07]]}];
lineLF1 = 
  Graphics3D[{Red, 
    Tube[{{center - .5, b/2, .75 h}, {center + .5, b/2, .75 h}}, 
     0.07]}];
lineLF2 = 
  Graphics3D[{Red, 
    Tube[{{center, b/2, .73 h}, {center, b/2, .77 h}}, 0.07]}];
lineC1 = Graphics3D[{Black, 
    Tube[{{center - .5, b/2, .82 h}, {center + .5, b/2, .82 h}}, 
     0.07]}];
lineC2 = Graphics3D[{Black, 
    Tube[{{center, b/2, .8 h}, {center, b/2, .84 h}}, 0.07]}];
line2 = Graphics3D[{Thick, Blue, 
    Line[{{13.2, 10, .75 h + 1.1}, {13.2, 10, .75 h - .1}}]}];
line3 = Graphics3D[{Thick, 
    Line[{{12.5, 10, .84 h}, {13.9, 10, .84 h}}]}];
line4 = Graphics3D[{Thick, 
    Line[{{13.2, 10, .84 h + .5}, {13.2, 10, .84 h - .6}}]}];
axeX = Graphics3D[{Red, Arrowheads[0.03], 
    Arrow[Tube[{{center - 27, b/2, .25 h}, {center - 27, 
        b/2 - 9, .25 h}}, 0.2]]}];
axeY = Graphics3D[{Blue, Arrowheads[0.03], 
    Arrow[
     Tube[{{center - 27, b/2, .25 h}, {center - 18, b/2, .25 h}}, 
      0.2]]}];
axeZ = Graphics3D[{Green, Arrowheads[0.03], 
    Arrow[Tube[{{center - 27, b/2, .25 h}, {center - 27, b/2, .57 h}},
       0.2]]}];
textLiquid = 
  Graphics3D[{Blue, 
    Text[Style["Fluid", FontSize -> 35], {center + 24, b/2, .2 h}]}];
texth = Graphics3D[{Black, 
    Text[Style["h", FontSize -> 35], {4.5, b/2, .91 h}]}];
textX = Graphics3D[{Red, 
    Text[Style["x", FontSize -> 35], {center - 28, b/2 - 10, .25 h}]}];
textY = Graphics3D[{Blue, 
    Text[Style["y", FontSize -> 35], {center - 17, b/2, .25 h}]}];
textZ = Graphics3D[{Green, 
    Text[Style["z", FontSize -> 35], {center - 27, b/2, .62 h}]}];
textLaserFocus = 
  Graphics3D[{Red, 
    Text[Style["Laser Focus", FontSize -> 35], {center + 11, 
      b/2, .7 h}]}];
textLaser = 
  Graphics3D[{LightYellow, 
    Text[Style["Laser Beam", FontSize -> 35], {center, b/2, h - 25}]}];
Show[bottomSurface, topSurface, sphere, liquid, laser, line, lineLF1, \
lineLF2, lineC1, lineC2, axeX, axeY, axeZ, textLiquid, texth, textX, \
textY, textZ, textLaserFocus, textLaser, Boxed -> False] 

Thank you very much. Lukas

Answer 1

I was trying to do something similar and created a useful solution. This answer uses Mathematica version 10.2.0.0.

First define a region, e.g. a sphere region:

region = ImplicitRegion[x^2 + y^2 + z^2 <= 10, {x, y, z}];

Now we can generate random points within this region using the function RandomPoint:

pts = RandomPoint[region, 20];(*this generates 20 random points within region1*)

Now we can put a water molecule onto each of these random points. We want to rotate the molecule first before we translate (you may find a better way to do this, but the following method works for me)

h2o := Table[
   GeometricTransformation[
    GeometricTransformation[
     GeometricTransformation[
      GeometricTransformation[
       GeometricTransformation[
        First@ChemicalData["Water", "MoleculePlot"],
        ScalingMatrix[{2*10^-3, 2*10^-3, 2*10^-3}]],(*The first transform is to scale the molecule*)
       RotationTransform[RandomReal[2*Pi], {1, 0, 0}]],(*The second transform is to rotate the molecule by a random angle about the x-axis*)
      RotationTransform[RandomReal[2*Pi], {0, 1, 0}]],(*The third transform is to rotate the molecule by a random angle about the y-axis*)
     RotationTransform[RandomReal[2*Pi], {0, 0, 1}]],(*The fourth transform is to rotate the molecule by a random angle about the z-axis*)
    TranslationTransform[{pts[[i, 1]], pts[[i, 2]], pts[[i, 3]]}]],(*The fifth transform is to translate the molecule by a random {x,y,z} vector which we defined using the RandomPoint function*)
   {i, 20}];

Graphics3D[h2o, Axes -> True, AxesLabel -> {"x", "y", "z"}, BoxRatios -> {1, 1, 1}]

We can increase the number of molecules arbitrarily (e.g. 10,000) but note that this does not take into consideration anything physical (i.e. chemical interactions, thermodynamics, etc.):

If you want to place different molecules in a more complicated region this is a convenient way to do so, e.g. TEOS inside a block copolymer sectioned along a {211} plane:

Check out this post for more details (and problems with RandomPoint).

Answer 2

Graphics3D[
 Table[
  Translate[
   Rotate[First@ChemicalData["Water", "MoleculePlot"], 
    RandomReal[{0, \[Pi]}], {8, .5, 0}], 
    {80 i, 160 RandomReal[{-1, 1}], 160 RandomReal[{-1, 1}]}], 
    {i, 1, 20}]
 ]