Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Fancy 3d plotting in Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg59968] Re: [mg59850] Fancy 3d plotting in Mathematica
• From: Zhengji Li <zhengji.li at gmail.com>
• Date: Fri, 26 Aug 2005 04:54:53 -0400 (EDT)
• References: <200508241030.GAA11936@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Here is my code showing how to combine a 2D graphic with a 3D graphic.

This gives what you need ?
Plot3DPlus[5Sin[Sqrt[
   x*x + y*y]]/Sqrt[x*x + y*y], {x, -10, 10}, {
       y, -10, 10}, Lighting -> False,
   ColorFunction -> Hue, PlotPoints -> 30, Post2DFunction ->
   ContourGraphics, Post2DPosition -> Below, AspectRatio -> 1];

To get exactly what you need, please see FullGraphics.

Post2DFunction::usage = "";
Post2DPosition::usage = "";
Above::usage = "";
Below::usage = "";
SubPlotOffset = 2;
Options[Plot3DPlus] = {
   Post2DFunction -> ContourGraphics, Post2DPosition -> Below};
Plot3DPlus[f_, xvar_, yvar_, opts___] := Module[
     {g, pr, data, fun, pos, res, zmin, zmax, z, scalez},
     Point2Dto3D[pt : {x_, y_, ___}] := {x, y, z};
     Point2Dto3D[Scaled[x_, y_, ___]] := Scaled[x, y, scalez];

     fun = Post2DFunction /. Flatten[{opts}~Join~Options[Plot3DPlus]];
     pos = Post2DPosition /. Flatten[{opts}~Join~Options[Plot3DPlus]];

     g = Plot3D[f, xvar, yvar,
     DisplayFunction -> Identity, Evaluate@DeleteCases[Flatten@{opts},
              Rule[Post2DFunction, _] | Rule[Post2DPosition, _]]];
     pr = PlotRange /. AbsoluteOptions[g, PlotRange];
     {zmin, zmax} = pr[[3]];
     If[pos === Below,
       z = zmin - SubPlotOffset(zmax - zmin); zscale = 0,
       z = zmax + SubPlotOffset(zmax - zmin); zscale = 1
       ];

     data = Flatten[Graphics[fun[g]][[1]]];
     data = DeleteCases[
     data, _Rectangle | _Circle | _Disk | _Raster | _RasterArray];
     data = (If[MemberQ[{Line, Polygon, Point},
           Head@#], (Head@#)[Function[pt, Point2Dto3D[pt]] /@ #[[
     1]]], #]) & /@ data;
     res = {g, Graphics3D[data, Lighting -> False]};
     Show[res, DisplayFunction -> $DisplayFunction];
     res
];

--
Li Zhengji
-------------------------------------------------------------
If all you have is a hammer, everything is a nail.
-------------------------------------------------------------

• References:
  • Fancy 3d plotting in Mathematica
    • From: mike_in_england2000@yahoo.co.uk