MathGroup Archive 2007

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

Search the Archive

Clipping Live3DGraphics


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