1

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.

Contour plots on each face together with a region of defined amplitude

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.

Projection of the contour plots with realistic lighting

When I add the ListContourPlot3D, the shading changed and looked bad.

Complete picture with mixed up shading 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}];
kglr
  • 394,356
  • 18
  • 477
  • 896
Aurelia
  • 11
  • 1
  • If you are playing with ellypse I highly recommend using Graphics3D primitives like in this answer: How to render 3D ellipse. Notice that there are two-axis ellipse but just add 3rd parametr for ScalingTransform. – Kuba Nov 29 '13 at 06:13

1 Answers1

2

Not really an answer but comments do not allow graphics.

Your results might be due to the drivers of the graphics card. Your code produces the intended result on mine:

enter image description here

By the way, you might want to check Edit->Preferences->Appearance->Graphics->Antialiasing quality (the contour lines of your graphics are not aliased).

Hector
  • 6,428
  • 15
  • 34