|
[Date Index]
[Thread Index]
[Author Index]
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
|