Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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? My image:

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.

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

1 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}]]}]]

Mathematica graphics


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*)

Mathematica graphics

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 *)

Mathematica graphics


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]

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.