       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}]];

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

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