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