MathGroup Archive 2009

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

Search the Archive

Re: Plotting surface with thickness

  • To: mathgroup at smc.vnet.net
  • Subject: [mg100977] Re: [mg100915] Plotting surface with thickness
  • From: "David Park" <djmpark at comcast.net>
  • Date: Thu, 18 Jun 2009 20:50:39 -0400 (EDT)
  • References: <322649.1245316788499.JavaMail.root@n11>

top[x_, y_] := Sin[x y]
bottom[x_, y_] := Sin[x y] - 0.5

You could try something like the following:

RegionPlot3D[
 bottom[x, y] < z < top[x, y] \[And] -1 < x < 1 \[And] -1 < y < 
   1, {x, -1, 1}, {y, -1, 1}, {z, -2, 1}]

But that looks more like a cushion than a thick surface. So with the
Presentations package I would get a nice crisp thick surface by drawing all
of the sides.

Needs["Presentations`Master`"]

Draw3DItems[
 {(* Draw the top and bottom *)
  Orange,
  Draw3D[top[x, y], {x, -1, 1}, {y, -1, 1}, Mesh -> None],
  Draw3D[bottom[x, y], {x, -1, 1}, {y, -1, 1}, Mesh -> None],
  (* Draw the four sides *)
  Brown,
  ParametricDraw3D[{x, -1, z}, {x, -1, 1}, {z, bottom[x, -1], 
    top[x, -1]}, Mesh -> None],
  ParametricDraw3D[{x, 1, z}, {x, -1, 1}, {z, bottom[x, 1], 
    top[x, 1]}, Mesh -> None],
  ParametricDraw3D[{-1, y, z}, {y, -1, 1}, {z, bottom[-1, y], 
    top[-1, y]}, Mesh -> None],
  ParametricDraw3D[{1, y, z}, {y, -1, 1}, {z, bottom[1, y], 
    top[1, y]}, Mesh -> None]},
 NeutralLighting[0, .5, .1],
 NiceRotation,
 Boxed -> False,
 ImageSize -> 350]


David Park
djmpark at comcast.net
http://home.comcast.net/~djmpark/  



From: Bill [mailto:WDWNORWALK at aol.com] 

Plotting surface with thickness

Hi:

Using the following code with Mathematica 5.2 works without any problem. 
Using it with Mathematica 6.0.1 doesn't work.


top = Plot3D[Sin[x y], {x, -1, 1}, {y, -1, 1}]

bottom = Plot3D[Sin[x y] - 0.5, {x, -1, 1}, {y, -1, 1}]

g = Plot[{Sin[x y], Sin[x y] - 0.5} /. y -> -1 // Evaluate, {x, -1, 1}]

(* Mathematica 5.2 works with the following line, Mathematica 6.0.1 does
not. *)

front = Graphics3D[
  Polygon[Insert[#, -1, 2] & /@ 
    Join[g[[1, 1, 1, 1, 1]], Reverse[g[[1, 2, 1, 1, 1]]]]]]


Question: How can the code (front) be modified to run in Mathematica 6.0.1?



Thanks,

Bill


Ref:  http://forums.wolfram.com/student-support/topics/7384




  • Prev by Date: Re: Hypergeometric2F1 gives wrong complex infinities
  • Next by Date: Re: Re: Help with Hold
  • Previous by thread: Plotting surface with thickness
  • Next by thread: Re: Plotting surface with thickness