Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2007

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

Search the Archive

Re: Zoom2D and GetGraphicsCoordinates palettes combined

  • To: mathgroup at smc.vnet.net
  • Subject: [mg83139] Re: Zoom2D and GetGraphicsCoordinates palettes combined
  • From: dh <dh at metrohm.ch>
  • Date: Tue, 13 Nov 2007 03:31:13 -0500 (EST)
  • References: <fh995p$b8j$1@smc.vnet.net>


Hi Ingolf,

thank's that you put in some work to improve the zoom utility.

Unfortunately, there went something wrong when you pasted the code to 

the E-mail:"$LocatorPositions == b" should read "$LocatorPositions = b". 

I think the superfluous equal signe is actually a line continuation.

Please repost the code.

all the best, Daniel



Ingolf Dahl wrote:

> To MathGroup,

> 

> Daniel [dh at metrohm.ch] recently posted a really nice Zoom2D palette. I have

> earlier posted a GetGraphicsCoordinates palette. I have now tried to combine

> these palettes, in such a way that it is possible to zoom 2D-graphics, and

> then select points inside the zoomed picture (with better accuracy). I have

> thus made some changes to Daniel's palette:

> 

> The palette is now self-contained, and does not require reloading of code if

> the Kernel is restarted. If the palette is installed as palette, it might be

> loaded from the Palette drop down menu.

> 

> I have changed the way to set the AspectRatio. One setting allows keeping

> the proportions of the scales of the axes, another allows setting a chosen

> fixed value of the AspectRatio.

> 

> Now it is possible to choose the cell bracket (or the graphics itself) of a

> graphics cell to operate with the palette. The palette does not accept

> graphics with dynamic content.

> 

> As in Daniel's palette, the Zoom button opens a new notebook containing two

> graphic areas: one containing a copy of the chosen graphics, where a zoom

> window can be set interactively, and another area where the zoomed window is

> shown. In the zoomed window you might click to create "locators". There is

> an InputField where the coordinates of the locators are shown, and where

> they also might be edited. Then there is also a button, which copies these

> coordinates to the clipboard and also sets the variable $LocatorPositions.

> You can use "Paste" to paste the coordinates wherever you like (inside or

> outside Mathematica).

> 

> Another button copies the zoomed graphics, with the chosen AspectRatio, but

> without the LocatorPane and the locators.

> 

> Copy the code below to Mathematica (6.0.0 or later) and evaluate. A small

> palette appears in the upper right corner. To save it, move it with the

> mouse and close it. Save as a file. I save it at "C:\Documents and

> Settings\Username\Application

> Data\Mathematica\Applications\Palettes\FrontEnd\Palettes", but you might

> instead save it anywhere and install it from the Mathematica Palette menu,

> if you prefer.

> 

> Do not forget to save any important work in any open program, and do not

> blame me if Mathematica crashes...

> 

> No, there is no object snap or curve snap included. That would be a quite

> different tool, or rather many different tools, to satisfy all the different

> demands that might be put on such a tool.

> 

> Best regards

> 

> Ingolf Dahl

> http://web.telia.com/~u31815170/Mathematica/

> 

> *******************************************************************

> CreatePalette[

>   Button["Zoom",

>    Module[{g, g0, g1, pp1, pp2, arorg},

>     g0 = NotebookRead[SelectedNotebook[]];

>     g0 = Cases[g0, Graphics[__] | GraphicsBox[__], {0, Infinity}, 1];

>     g1 = Catch[

>       If[g0 === {}, Throw[{}]];

>       g =

>        If[Head[g0[[1]]] == GraphicsBox, ToExpression[g0[[1]]],

>         g0[[1]]];

>       If[Length[Cases[g0, Dynamic[__], {0, Infinity}, 1]] > 0,

>        Throw[{}]];

>       {pp1, pp2} = (PlotRange /. AbsoluteOptions[g]);

>       If[And[MatchQ[pp1, {_?NumberQ, _?NumberQ}],

>         MatchQ[pp2, {_?NumberQ, _?NumberQ}]], {pp1, pp2} =

>         Transpose[{pp1, pp2}], Throw[{}]];

>       {pp1, pp2} = {0.75 pp1 + 0.25 pp2, 0.25 pp1 + 0.75 pp2};

>       arorg = (AspectRatio /. AbsoluteOptions[g]);

>       If[Not[NumberQ[arorg]], Throw[{}]];

>       DynamicModule[{p1 = pp1, p2 = pp2, lp = {0, 0},

>         aspectswitch = 0, pts = {{0, 0}}, aspectslider = 1,

>         arorgdyn = arorg*(pp2[[1]] - pp1[[1]])/(pp2[[2]] - pp1[[2]])},

>         Column[{LocatorPane[Dynamic[{p1, p2}],

>          

>           Show[{g,

>             Graphics[{Opacity[0.1],

>               Rectangle[Dynamic[p1], Dynamic[p2]]}]},

>            ImageSize -> Small]],

>          TextCell["Zoom corners:"],

>          InputField[Dynamic[p1], FieldSize -> 14],

>          InputField[Dynamic[p2], FieldSize -> 14],

>          Row[{TextCell["AspectRatio set by slider:"],

>            Checkbox[Dynamic[aspectswitch], {0, 1}]}],

>          Dynamic[If[aspectswitch == 1,

>            Row[{Slider[Dynamic[aspectslider], {0.2, 5., 0.1},

>               ImageSize -> 150],

>              InputField[Dynamic[aspectslider], FieldSize -> 3]}],

>            TextCell["AspectRatio is kept as zoomed area."]]],

>          LocatorPane[Dynamic[pts],

>           Show[g, PlotRange :> Dynamic[Transpose[{p1, p2}]],

>            Frame -> True, ImageSize -> Full,

>            AspectRatio ->

>             Dynamic[

>              Which[aspectswitch == 0,

>               Abs[arorgdyn*(p2[[2]] - p1[[2]])/(p2[[1]] - p1[[1]])],

>               aspectswitch == 1, aspectslider]]],

>           LocatorAutoCreate -> True],

>          TextCell["Use Alt+Click to add or delete locators!"],

>          TextCell["Locator positions:"],

>          InputField[Dynamic[pts], FieldSize -> 14],

>          Button[

>           Copy locator positions, (SelectionMove[ButtonNotebook[],

>             All, ButtonCell];

>            SelectionMove[ButtonNotebook[], All, CellContents];

>            SelectionMove[ButtonNotebook[], All, CellContents];

>            FrontEndExecute[FrontEndToken[ButtonNotebook[], "Copy"]];

>            Module[{b}, b = NotebookRead[ButtonNotebook[]];

>             If[Length[b] >= 2, b = b[[1, 5]]; $LocatorPositions = =

> b;

>              SelectionMove[ClipboardNotebook[], All, Notebook];

>              NotebookWrite[ClipboardNotebook[], ToBoxes[b], All];

>              SelectionMove[ClipboardNotebook[], All, Notebook];

>              SelectionMove[ButtonNotebook[], Before, Cell]]])],

>          Button[Copy zoomed graphics, (SelectionMove[ButtonNotebook[],

>              All, ButtonCell];

>            SelectionMove[ButtonNotebook[], All, CellContents];

>            FrontEndExecute[FrontEndToken[ButtonNotebook[], "Copy"]];

>            Module[{b}, b = NotebookRead[ButtonNotebook[]];

>            

>             If[Length[b] >= 2,

>              b = Cell[BoxData[#1],

>                  "Output"] &@(b[[2, 1, 1, 7, 1,

>                   2]] /. {(PlotRange :> _) -> (PlotRange ->

>                     Transpose[

>                     b[[1, {1,

>                     2}]]]), (AspectRatio -> _) -> (AspectRatio ->

>                     Which[b[[1, 4]] == 0,

>                     Abs[b[[1,

>                     7]]*(b[[1, 2]][[2]] -

>                     b[[1, 1]][[2]])/(b[[1, 2]][[1]] -

>                     b[[1, 1]][[1]])], b[[1, 4]] == 1,

>                     b[[1, 6]]]), (ImageSize -> Full) -> Sequence[]});

>              SelectionMove[ClipboardNotebook[], All, Notebook];

>              NotebookWrite[ClipboardNotebook[], b, All];

>              SelectionMove[ClipboardNotebook[], All, Notebook];

>              SelectionMove[ButtonNotebook[], Before, Cell]]])],

>          Dynamic[MousePosition["Graphics"]]}, Center]]];

>     If[g1 === {}, CreateDialog[{TextCell["Zoom:

>        

>         No proper input available. Select some 2D, Mathematica-6 type \

> grahics and \npress the Zoom button again! Please avoid dynamic \

> content!"], DefaultButton[]}],

>      CreateDocument[g1, WindowSize -> {290, All},

>       WindowTitle -> "Zoom-DHID",

>       WindowElements -> {"VerticalScrollBar"},

>       WindowFrame -> "Palette", Background -> GrayLevel[0.96]]]]],

>   WindowTitle -> "Zoom2D"];

> 

> 

> 




  • Prev by Date: Re: Dividers formatting in Grid
  • Next by Date: Re: Select[ ] Woes
  • Previous by thread: Re: Zoom2D and GetGraphicsCoordinates palettes combined
  • Next by thread: RE: Zoom2D and GetGraphicsCoordinates palettes combined