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