Re: Mouse controlled 3D rotations
- To: mathgroup at smc.vnet.net
- Subject: [mg57880] Re: Mouse controlled 3D rotations
- From: "Hugh Goyder" <h.g.d.goyder at cranfield.ac.uk>
- Date: Sat, 11 Jun 2005 03:35:35 -0400 (EDT)
- Organization: University of Warwick, UK
- References: <d8bcer$fec$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Dear Jim, Surprisingly Mathematica does not support mouse controlled rotations. The graphics are composed in a manner that makes this possible but it is not implemented. My normal approach is to use the free applet from Martin Kraus which works very well. It may be found at http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/ However, Mathematica does now have a GUIkit and this should be the internal way of making mouse controlled rotations. I have had a go at making the GUIkit undertake this task. It works but it is not very successful because it is so slow. I enclose my development example, below, in case anyone can see a way to make this work quickly. For your animations issues you should be aware that the normal route is to make a number of slides and then double click on one slide to get the animations to work. If you search the mathgroup archive you will find code for collapsing all the slides after they have been produced to give a neater effect. Hugh Goyder Needs["GUIKit`"] gg = Graphics3D[ Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, 2Pi}, PlotPoints -> {30, 30}, ColorFunction -> Hue]]; ex = Widget["Panel", { {Widget["Label", {"text" -> "x:"}], Widget["Slider", {BindEvent["change", Script[sliderFunc[];]]}, Name -> "sx", WidgetLayout -> {"Stretching" -> {Maximize, False}}]}, {Widget["Label", {"text" -> "y:"}], Widget["Slider", {BindEvent["change", Script[sliderFunc[];]]}, Name -> "sy", WidgetLayout -> {"Stretching" -> {Maximize, False}}]}, {Widget["Label", {"text" -> "z:"}], Widget["Slider", {BindEvent["change", Script[sliderFunc[];]]}, Name -> "sz", WidgetLayout -> {"Stretching" -> {Maximize, False}}]}, Widget["MathPanel", {"preferredSize" -> Widget["Dimension", {"width" -> 288, "height" -> 288}]}, Name -> "canvas", WidgetLayout -> {"Stretching" -> {True, Maximize}}], "preferredSize" -> Widget["Dimension", {"width" -> 288, "height" -> 340}], BindEvent["componentResized", Script[sliderFunc[];]], Script[ sliderFunc[] := Module[{ax, ay, az }, ax = ToExpression[PropertyValue[{"sx", "value"}]]; ay = ToExpression[PropertyValue[{"sy", "value"}]]; az = ToExpression[PropertyValue[{"sz", "value"}]]; expr = Show[gg, PlotRange -> All, ViewPoint -> {ax, ay, az}, DisplayFunction -> Identity]; SetPropertyValue[{"canvas", "mathCommand"}, ToString[expr, InputForm]] ]; sliderFunc[]; ] }]; RealTimePlot[] := GUIRun[ex, IncludedScriptContexts -> {$Context}]; RealTimePlot[] "Jim Hafner" <hafner at almaden.ibm.com> wrote in message news:d8bcer$fec$1 at smc.vnet.net... > Is there a way to build a 3D graphics object (e.g., a simple > Tetrahedron) and manipulate it (e.g., rotate it in 3D) with the mouse? > > There is an example on webMathematica of just this, but I haven't > figured out how to do it at all in plain ol' Mathematica. > > Does it matter what system I'm on (AIX 5.1 or WinXP)? > > I noticed that on AIX5.1, starting math kernel (no notebooks) that I can > use Animate[] to make a movie of a rotating Tetrahedron. In XP, the > same doesn't produce anything. On either system, in a notebook, I just > get multiple graphics objects, one for each rotational position -- > there's no live animation. > > Any guidance is appreciated. > > Jim Hafner > hafner at almaden.ibm.com >