I want to combine some ListContourPlot3D and Graphics3D to present, on one 3D plot, the projection of the contour plots on each face of the cube and a region of defined amplitude. Here is a working example.
I also want to add shading on the projected contours so that it appears more realistic. I succeeded in obtaining a realistic result using VertexNormals.
When I add the ListContourPlot3D, the shading changed and looked bad.
Do you have any suggestions for keeping the shading as in Fig. 2 (GraphContour in the code below) even when the ListContourPlot3D plot is added. (GraphComplete)?
(*Define the vector for use in VertexNormals*)
{p1, p2,p3} = {{1, 0, 0}, {1, 1, 1}, {0, 0, 1}};
n = Cross[p2 - p1, p3 - p1];
(*Define constants for the boundary of the table*)
Rmin = -0.5; Rmax = 0.5; Rstep = 0.1; Rlength = (Rmax - Rmin)/Rstep; R0 = Rlength/2;
sphere =
Table[(Rx^2 + 0.6 Ry^2 + 0.5 Rz^2),
{Rx, Rmin, Rmax,Rstep}, {Ry, Rmin, Rmax, Rstep}, {Rz, Rmin, Rmax, Rstep}];
(*Plot of the region representing value of 5%*)
SphereP =
ListContourPlot3D[sphere/Max[sphere],
Contours -> {0.05}, AxesLabel -> {"x", "y", "z"},
DataRange -> {{Rmin, Rmax}, {Rmin, Rmax}, {Rmin, Rmax}},
MeshStyle -> Directive[Red, Opacity[0]],
Lighting -> "Neutral", Boxed -> False,
ContourStyle -> Directive[Orange, Opacity[0.9]],
AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}];
(*Define contour plot for projection on the cube faces*)
ContourXZ =
ListContourPlot[
Table[(sphere[[Rx]][[R0]][[Rz]])/Max[sphere], {Rx, 1, Rlength}, {Rz, 1, Rlength}],
DataRange -> {{Rmin, Rmax}, {Rmin, Rmax}}, Contours -> 10,
Axes -> False, PlotRangePadding -> 0, Frame -> False,
PlotLegends -> None, ClippingStyle -> Automatic, PlotRange -> {0, 1},
ColorFunction -> ColorData[{"SunsetColors", "Reverse"}]];
level = Rmin; (*Level at which the contour appears*)
grIntXZ =
Graphics3D[
{Texture[ImageData @ Rasterize[ContourXZ, "Image"]], EdgeForm[],
Polygon[{{Rmin, Rmin, level}, {Rmax, Rmin, level},
{Rmax, Rmax,level}, {Rmin, Rmax, level}},
VertexNormals -> {n, n, n, -n},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
Lighting -> "Neutral"];
ContourXY =
ListContourPlot[
Table[(sphere[[Rx]][[Ry]][[R0]])/Max[sphere], {Rx, 1,Rlength}, {Ry, 1, Rlength}],
DataRange -> {{Rmin, Rmax}, {Rmin, Rmax}}, Contours -> 10,
Axes -> False, PlotRangePadding -> 0, Frame -> False,
PlotLegends -> None, ClippingStyle -> Automatic, PlotRange -> {0, 1},
ColorFunction -> ColorData[{"SunsetColors", "Reverse"}]];
level = -0.5; (*Level at which the contour appears*)
grIntXY =
Graphics3D[
{Texture[ContourXY], EdgeForm[],
Polygon[{{level, Rmin, Rmin }, {level, Rmax, Rmin},
{level, Rmax,Rmax}, {level, Rmin, Rmax}},
VertexNormals -> {n, -n, n, n},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
Lighting -> "Neutral"];
level = +0.5; (*Level at which the contour appears*)
ContourYZ =
ListContourPlot[
Table[(sphere[[R0]][[Ry]][[Rz]])/Max[sphere], {Ry, 1,Rlength}, {Rz, 1, Rlength}],
DataRange -> {{Rmin 10^6, Rmax 10^6}, {Rmin 10^6, Rmax 10^6}},
Contours -> 10, Axes -> False, PlotRangePadding -> 0, Frame -> False,
PlotLegends -> None, ClippingStyle -> Automatic,
PlotRange -> {0, 1}, ColorFunction -> ColorData[{"SunsetColors", "Reverse"}]];
grIntYZ =
Graphics3D[
{Texture[ContourYZ], EdgeForm[],
Polygon[{{Rmin , level, Rmin }, {Rmax, level, Rmin},
{Rmax,level, Rmax}, { Rmin, level, Rmax }},
VertexNormals -> {-n, n, n, n},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
Lighting -> "Neutral"];
(*Without the ListContourPlot3D, the shading are nice and realists*)
GraphContour =
Show[grIntXZ, grIntXY, grIntYZ,
PlotRange -> All,BoxRatios -> {1, 0.9,0.9}];
(*Everything get disturbed when adding the ListContourPlot3D*)
GraphComplete =
Show[SphereP, grIntXZ, grIntXY, grIntYZ,
PlotRange -> All, BoxRatios -> {1, 0.9, 0.9}];
ScalingTransform. $\endgroup$