MathGroup Archive 2007

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

Search the Archive

Clipping Live3DGraphics

  • To: mathgroup at smc.vnet.net
  • Subject: [mg76700] Clipping Live3DGraphics
  • From: chuck009 <dmilioto at comcast.com>
  • Date: Sat, 26 May 2007 04:26:08 -0400 (EDT)

My understanding is that Live3DGrahics won't clip the plot to the plot range.  Sometimes it's nice to be able to do this.  The following code will clip a Graphics3D object to the specified inequality passed to ClipGraphics3D.

For example, suppose I create:

plot1=Graphics3D[Plot[Exp[x^2+y^2],{x,0,3},{x,0,3}],PlotRange->{{0,1},{0,1},{0,1}},AspectRatio->1,BoxRatios->{1,1,1}];

If I pass plot1 to Live3DGraphics, it will plot everything.  Suppose though I only wish to view the clipped plot with Abs[z]<=1.  I enter:

clipped=Fold[ClipGraphics3D,plot1,{z<=1,z>=-1}];

then pass clipped to the Live applet.  

Is there an easier way to do this?

ClipGraphics3D[g_, inequality_] := Module[{tagpts, t, newpts},
      g /. Polygon[pts_] :> (tagpts = TagPoints[inequality] /@ pts; t =
     AdjustPoints[Equal @@ inequality] @@@ Transpose[{tagpts, RotateLeft[
        tagpts]}];
            newpts = Cases[t, {
      p_, label_} /; label == 
          1 :> p, 2]; If[Length[newpts] > 2, Polygon[newpts], {}])
      ];

TagPoints[inequality_][p_] := Block[{x, y, z}, {x, y, z} = 
    p; If[inequality, {p, 1}, {p, 2}]];

AdjustPoints[equation_][
      p1_, p2_] := Block[{px}, If[p1[[
        2]] === p2[[2]], {p1}, px = SolveClipEq[equation, p1, p2]; {p1, {px,
         p1[[2]]}, {px, p2[[2]]}}]];

SolveClipEq[equation_, {p1_, _}, {p2_, _}] := 
        Block[{p, d, x, y, z}, {x, y, z} = p = p1(1 - d) + 
        p2d; First[
          Cases[Solve[equation, d], s_ /; NonNegative[
            d /.\[InvisibleSpace]s] :> (p /.\[InvisibleSpace]s)]]];


  • Prev by Date: Re: New in Version 6
  • Next by Date: Sierpinski's thing
  • Previous by thread: Re: Sierpinski's carpet
  • Next by thread: Re: Clipping Live3DGraphics