Zoom2D and GetGraphicsCoordinates palettes combined
- To: mathgroup at smc.vnet.net
- Subject: [mg83125] Zoom2D and GetGraphicsCoordinates palettes combined
- From: "Ingolf Dahl" <ingolf.dahl at telia.com>
- Date: Mon, 12 Nov 2007 05:12:33 -0500 (EST)
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"];
- Follow-Ups:
- Version 3: Zoom2D and GetGraphicsCoordinates palettes combined
- From: "Ingolf Dahl" <ingolf.dahl@telia.com>
- RE: Zoom2D and GetGraphicsCoordinates palettes combined
- From: "Ingolf Dahl" <ingolf.dahl@telia.com>
- Version 3: Zoom2D and GetGraphicsCoordinates palettes combined