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