31
$\begingroup$

I have a ListlinePlot function, that I would like to combine with both a Graphics3D plot and a ListPointPlot3D plot, in such a way that the ListLinePlot is the bottom of the 3D boundary cube for the 3D plots. Can this be done in Mathematica 8.0.4?

Obviously the code below fails to combine the plots in Show, but is there another way to accomplish this? Thanks!

    Needs["TetGenLink`"]
twodPts = RandomReal[{-1, 1}, {10, 2}];
threedPts = RandomReal[{-1, 1}, {50, 3}];
{pts, surface} = TetGenConvexHull[threedPts];

twoDptsPlot = ListLinePlot[twodPts, ImageSize -> {200, 200}];
threeDPtsPlot = ListPointPlot3D[threedPts, ImageSize -> {200, 200}];
surfacePlot = 
  Graphics3D[{EdgeForm[], Opacity[0.3], 
    GraphicsComplex[pts, Polygon[surface]], ImageSize -> {200, 200}}];

{twoDptsPlot, 
 Show[threeDPtsPlot, surfacePlot, ImageSize -> {200, 200}, 
  BoxRatios -> 1, Axes -> False]}

Mathematica graphics

Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ I've edited your code a bit, and included some figure, please feel free to roll back if you don't agree with the change in the Show line. $\endgroup$
    – István Zachar
    Commented Mar 29, 2012 at 13:08
  • $\begingroup$ I seem to remember we have had the same type of question before, perhaps on SO/mathematica. Can't find it at the moment. One easy approach would be to Texture a plane with the 2D plot. $\endgroup$
    – Sjoerd C. de Vries
    Commented Mar 29, 2012 at 13:16
  • 2
    $\begingroup$ this question might help $\endgroup$
    – Heike
    Commented Mar 29, 2012 at 13:55

4 Answers 4

Reset to default
28
$\begingroup$

The following is probably what you want.

Make3d[plot_, height_, opacity_] := 
  Module[{newplot},
    newplot = First@Graphics[plot]; 
    newplot = N@newplot /. {x_?AtomQ, y_?AtomQ} :> {x, y, height};
    newplot /. GraphicsComplex[xx__] :> {Opacity[opacity], GraphicsComplex[xx]}
  ]

Show[{Graphics3D[Make3d[twoDptsPlot, -1, .75]], threeDPtsPlot,surfacePlot}, Axes -> True]

which gives enter image description here

This function can takes any 2D plot and place it on a 3D box with a specified height. I got this trick in the web few years back but now cant remember the reference. Hope this helps you.

Improve this answer
$\endgroup$
5
  • 2
    $\begingroup$ I saw the method in this a while ago. mathgis.blogspot.com/2009/02/howto-display-2d-plot-in-3d.html $\endgroup$
    – Ajasja
    Commented Mar 29, 2012 at 14:10
  • $\begingroup$ @Ajasja You are right this is the link I was looking for.. $\endgroup$
    – PlatoManiac
    Commented Mar 29, 2012 at 14:17
  • $\begingroup$ @PlatoManiac Make3d[plot_, height_, opacity_] does not respect the colour of plot_ when this made by Graphics, for example: s = Graphics[Polygon[{{0, 0}, {1, 1}, {0, 1}, {1, 0}}], BaseStyle -> Red] Show[{Graphics3D[Make3d[s, 0, 100.8]]}, Axes -> False, Boxed -> False] what can I do to stick to the original colour? $\endgroup$
    – Mencia
    Commented Jun 17, 2015 at 20:42
  • $\begingroup$ @Mr.Wizard♦ any idea on my comment just above ? $\endgroup$
    – Mencia
    Commented Jun 18, 2015 at 9:59
  • 1
    $\begingroup$ @Mencia Sjoerd's Texture method is probably easiest if you want a complete image of the 2D plot with all options considered. (You can rasterize at a higher resolution of the texture quality is not as good as you would like.) Otherwise I would suggest manually adding specific handling for BaseStyle and anything else you want, perhaps Prolog and Epilog, Background, etc. If you have trouble extracting and integrating these option values let me know. $\endgroup$
    – Mr.Wizard
    Commented Jun 19, 2015 at 3:24
14
$\begingroup$

You explicitly ask for the ListLinePlot to be placed in the Graphics3D, not just the lines contained in the plot. Since none of the answers so far do that here is my version.

surfacePlot = 
 Graphics3D[{EdgeForm[], {Texture[twoDptsPlot], 
    Polygon[{{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}}, 
     VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}, 
     {Opacity[0.3], GraphicsComplex[pts, Polygon[surface]]}}, 
   ImageSize -> 400, 
   Lighting -> "Neutral"]

Show[surfacePlot, threeDPtsPlot, Axes -> False]

Mathematica graphics

Improve this answer
$\endgroup$
3
  • $\begingroup$ This looks like a cool approach @Sjoerd C. de Vries, thanks for the great code! $\endgroup$
    – Nothingtoseehere
    Commented Mar 29, 2012 at 22:23
  • 2
    $\begingroup$ Might want to use Texture[ImageData[Rasterize[twoDptsPlot, Background -> None]]] if you need the texture to have transparency. $\endgroup$
    – Brett Champion
    Commented Mar 30, 2012 at 2:28
  • $\begingroup$ @Sjoerd C. de Vries @Mr.Wizard♦ I am trying to use this method. But I would like to combine the ListLinePlot with a ListPlot3D. I am trying this: surfacePlot = Graphics3D[{ EdgeForm[], {Texture[twoDptsPlot], Polygon[{{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}}, VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]} , ListPlot3D[{{1, 4, 2}, {6, 3, 9}, {1, 9, 4}}]}, ImageSize -> 400, Lighting -> "Neutral"] but it doesn't work. Any suggestion? $\endgroup$
    – Mencia
    Commented Jun 21, 2015 at 16:12
10
$\begingroup$

This is an approach that uses the graphics primitive Line.

Needs["TetGenLink`"]
twodPts = Transpose[{RandomReal[{-1, 1}, {10}], RandomReal[{-1, 1}, {10}], 
    Table[-1, {10}]}];
threedPts = RandomReal[{-1, 1}, {50, 3}];
{pts, surface} = TetGenConvexHull[threedPts];
twoDptsPlot = Graphics3D[Line[twodPts], PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
    ImageSize -> {200, 200}];
threeDPtsPlot = ListPointPlot3D[threedPts, PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
    ImageSize -> {200, 200}];
surfacePlot = Graphics3D[{EdgeForm[], Opacity[0.3], GraphicsComplex[pts, Polygon[surface]],
    PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
    ImageSize -> {200, 200}}];
Show[threeDPtsPlot, surfacePlot, twoDptsPlot, ImageSize -> {200, 200},
    BoxRatios -> 1, Axes -> False]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Very Cool! Thanks very much! $\endgroup$
    – Nothingtoseehere
    Commented Mar 29, 2012 at 14:30
7
$\begingroup$

Just in case using a single Graphics3D may be of interest:

Graphics3D[{
  PointSize[.01], Red, Point /@ threedPts, 
  Blue, Thickness[.003], Line@(Insert[#, -1, -1] & /@ twodPts), 
  GraphicsComplex[pts, {EdgeForm[], FaceForm[{Pink, Opacity[0.4]}], Polygon[surface]}], 
  ImageSize -> {200, 200}
}]

gives

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Some amazing answers here! Thanks so much! $\endgroup$
    – Nothingtoseehere
    Commented Mar 31, 2012 at 16:59

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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