# Add contour lines to Graphics3D

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.

-
But there is a mesh, it consists of two elements. I am not sure I understand what you are looking for? – user21 Jul 16 '14 at 13:25
@user21 Welcome back :) – Öskå Jul 16 '14 at 13:26
@Öskå, thanks! I am here to get the FEM and computational geometry stuff started. – user21 Jul 16 '14 at 13:29
You might have a look at DiscretizeGraphics (Version 10 only) link – eldo Jul 16 '14 at 13:45
what is toPoint ? not defined. You are not even using pts at all in the example above. – Nasser Jul 16 '14 at 14:00

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]


-