# Filling between two arrays with ListPointPlot3D

I would like to Plot two Arrays and use the function Filling to generate a soil layer:

bb = {{32, 100, 2005}, {3, 110, 2025}, {4, 120, 2230}, {5, 130,
2130}, {6, 140, 2105}, {7, 150, 2013}, {8, 160, 2225}};
cc = {{32, 100, 1000}, {3, 110, 1020}, {4, 120, 1225}, {5, 130,
1125}, {6, 140, 1100}, {7, 150, 1008}, {8, 160, 1220}};
ListPlot3D[{cc, bb}] • Related, but in 2D: mathematica.stackexchange.com/questions/78626/… May 25, 2019 at 0:16
• This is an amazing use of Mathematica and the Wolfram Language!!! I have a minor in plant sciences and took a really influential soil science course in the process, can you clarify what you might want to do with this? How are you thinking you would be representing the various layers? It would be awesome to mark it up with the layer designations! May 25, 2019 at 6:38

Filling -> {2 -> {1, Directive[{Opacity[0.4], Red}]}} • David, what format is this image in? It looks so pretty on mobile! May 25, 2019 at 19:08
• @CATrevillian: I think it is PDF, but you can export the figure in numerous formats. May 25, 2019 at 19:33
• Definitely! Thank you! It shows the opacity accurately when I select it. It makes me wonder if we can upload 3D models somehow and observe them on a touchscreen interface May 25, 2019 at 19:36

Update: Since the two surfaces are separated by a plane a much easier approach is to fill both surfaces to a plane (say, the z == 1500 plane) between the two and post-process to remove the polygons whose third coordinates are constant at z:

z = 1500.;
DeleteCases[Normal[ListPlot3D[{cc, bb}, PlotRange -> {500, 3000},
Filling -> {1 -> {z, Opacity[.5, Green]}, 2 -> {z, Opacity[.5, Green]}}]],
Polygon[{{_, _, z} ..}, ___], All] David's method fills from the top surface to the z == 1 plane. To fill between the two surfaces we can

1. Create a ListPlot3D object, lp3D, using bb with filling to a plane below the cc surface (say, the plane z==0)
2. Post-process the output of the previous step (a) to replace the coordinates {x_, y_, 0.} with {x, y, w} using w from the entry of cc whose first two coordinates match {x,y}; (b) remove the polygons at the top and bottom (these happen to be in the first group of polygons)
3. Use Show to combine the result from the previous step with ListPlot3D of the two data sets.
lp3D = ListPlot3D[bb, Filling -> 0,
FillingStyle -> Opacity[.5, Green], PlotStyle -> None,
BoundaryStyle -> None, Mesh -> None];
assocc = Association[{#, #2} -> #3 & @@@ N[cc]];
lp3D = lp3D /. GraphicsComplex[a_, b___] :>
GraphicsComplex[a /. {x_, y_, 0.} :> {x, y, assocc[{x, y}]}, b];
lp3D = Replace[lp3D, {a___, {EdgeForm[], ___}, ___, b : {EdgeForm[], ___},  c___} :>
{a, b, c}, All];

Show[ListPlot3D[{cc, bb}, PlotRange -> {500, 3000}], lp3D] Note: If you define disp = Dispatch[{#, #2} -> #3 & @@@ N[cc]]; and use {x, y} /. disp in place of assocc[{x,y}], and {0, Infinity} in place of All above, this method also works in version 9.