Add contour lines to Graphics3D

Question

I am writing the following code:

points = {{6, 2.12, .4738}, {8, 2.05, .5254}, {10, 1.99, .5520}, {12, 
    1.73, .5595}};
faces = {{1, 2, 4}, {2, 3, 4}};
colors = {32.4, 24.3, 19.2, 16.5};
color1 = (colors[[1]] - Min[colors])/(Max[colors] - Min[colors]);
color2 = (colors[[2]] - Min[colors])/(Max[colors] - Min[colors]);
color3 = (colors[[3]] - Min[colors])/(Max[colors] - Min[colors]);
color4 = (colors[[4]] - Min[colors])/(Max[colors] - Min[colors]);
pts = Map[toPoint, points];
Graphics3D[{GraphicsComplex[ points, Polygon[faces], 
   VertexColors -> {RGBColor[color1, 0, 1], RGBColor[color2, 0, 1], 
     RGBColor[color3, 0, 1], RGBColor[color4, 0, 1]}]}, 
 BoxRatios -> {1, 1, 1/2}, Axes -> True, Lighting -> Automatic]

The result is successful, but lacks contour lines for a 3D effect. How can I add that feature?

Edit: pts is leftover code from something else. It does nothing. I am trying to get continuous mesh over the surface of both triangles to make them look more 3-dimensional. The two surfaces in the attached image are in different planes, but they share a common edge. I need contour lines or mesh to emphasize that these two surfaces are not in the same 2-dimensional plane.

Answer 1

It seems that regularly-spaced mesh parallel to the axes--not the mesh used to create the graphics--can only be drawn for "*Plot" type graphics (and not Graphics3D). Here is my attempt to draw it. Note that I don't know how to combine both types of meshes in one plot--I tried to use BoundaryStyle but it only drew the outline of the shape without the line running across it--so I just draw the plot twice and highlight different features of the graphics.

Show[ListPointPlot3D[points, 
  PlotStyle -> {Red, PointSize@Large}] (* vertices *),
 ListPlot3D[points, Mesh -> 50] (* regularly spaced mesh *),
 ListPlot3D[points, Mesh -> All, MeshStyle -> Directive[Red, Thick], 
  PlotStyle -> None] (* outline mesh *)]

---

Edit: mixing ListPlot3D for the surfaces and Graphics3D for the lines and vertices will give you the same results without having to use ListPlot3D twice.

Show[
 ListPlot3D[points, Mesh -> 50],
 Graphics3D[{Red, PointSize[Large], Point[points], Red, Thick, 
   Line[Subsets[points, {2}]]}]]

---

Edit 2: I spoke too soon. There is an errant line below the surface of the graphics, which makes sense since one can draw 6 lines connecting 4 points whereas the graphics only needs 5 lines to draw. I used Manipulate to find out where that line is and manually remove it from the list of lines will give the graphics without the extra line below.

vp = Options[Graphics3D, ViewPoint][[1, 2]];
Column@{Dynamic@vp,
  Manipulate[Show[
    ListPlot3D[points, Mesh -> 50],
    Graphics3D[{Red, PointSize@Large, Point[points], Red, Thick, 
        Line[#[[i]]], Black, Thin, Line[#]},
        Axes -> True] &@Subsets[points, {2}], 
    ViewPoint -> Dynamic[vp]], {i, 1, 6, 1}]}
(* i = 2 in control*)

Show[
 ListPlot3D[points, Mesh -> 50],
 Graphics3D[{Red, PointSize[Large], Point[points], Red, Thick, 
   Line[Delete[Subsets[points, {2}], 2]]}], ViewPoint -> vp]
(* you can leave the ViewPoint option out when evaluating this plot *)

---

Edit 3: Should have thought about this much earlier but I think the best solution would be to just plot a (white) mesh over your entire Graphics3D using ListPlot3D with PlotStyle -> None (to make the plot transparent except for the mesh lines), and appropriate Mesh and MeshFunctions options. This way your formatting for the graphics can be conserved.

Also, I find 1-direction mesh lines work better in this case than 2-, hence the {#1 &} in MeshFunctions. You can of course change it to {#1 &, #2 &} to make them go in 2 directions, or even {#1 &, #2 &, #3&} for 3 directions, though at that point the mesh starts to appear very busy.

Show[
(* this was your graphics *)
 Graphics3D[{GraphicsComplex[points, Polygon[faces], 
    VertexColors -> {RGBColor[color1, 0, 1], RGBColor[color2, 0, 1], 
      RGBColor[color3, 0, 1], RGBColor[color4, 0, 1]}]}], 

(* just add this ListPlot3D below it and wrap everything in a Show*)
 ListPlot3D[points, Mesh -> 100, MeshStyle -> White, PlotStyle -> None,
   MeshFunctions -> {#1 &}], 
BoxRatios -> {1, 1, 1/2}, Axes -> True]