Zoom2D and GetGraphicsCoordinates palettes combined
Ingolf Dahl
Daniel [d...@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"];
dh
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
As Daniel kindly points out, the code should read "$LocatorPositions = b",
instead of double equal sign. It is corrected in the code below.
Ingolf Dahl
To MathGroup,
Best regards
Ingolf Dahl
http://web.telia.com/~u31815170/Mathematica/
$LocatorPositions = b;
Muench, Thomas
I like your Palette! There seems to be a bug, however, which I cannot
resolve (and which was also present in the original zoom2D palette)
The Zoom function does not work with graphics that have a
AspectRatio->Full option (either the graphic itself, or an Inset within
the Graphic)
Example:
This works:
Graphics[{Blue, Rectangle[], Red, Disk[]}, AspectRatio -> Automatic]
This doesn't work:
Graphics[{Blue, Rectangle[], Red, Disk[]}, AspectRatio -> Full]
Here is another example, which also shows why "Full" might be needed as
an option (Imagine the blue rectangle in the example below being a
graphic which shows a curve representing the time-course of data with a
much greater span along the x-axis (0...200) than along the y-axis
(-1...1). AspectRatio->Full makes sure that the complete area of the
Inset[...] is filled out by the graphics, instead of just generating a
narrow stripe in which nothing really is visible). This example also
illustrates that the AspectRatio of the Graphics in the newly generated
pop-up notebook is governed by the Inset, not by the parent-graphic:
This doesn't work at all:
Graphics[{Red, Disk[],
Inset[Graphics[{Blue, Rectangle[{0, -1}, {200, 1}]},
AspectRatio -> Full], {0, 0}, Automatic, {1, .5}]}]
This sort-of works:
Graphics[{Red, Disk[],
Inset[Graphics[{Blue, Rectangle[{0, -1}, {200, 1}]},
AspectRatio -> Automatic], {0, 0}, Automatic, {1, .5}]}]
Greetings,
Thomas
Ingolf Dahl
Correction in the code below!
As Daniel kindly points out, the code should read "$LocatorPositions = b",
instead of double equal sign. It is corrected in the code below.
Thomas Muecnch has also pointed out problems together with Inset graphics
and the option Full for AspectRatio. I think the behaviour now is somewhat
better
Ingolf Dahl
To MathGroup,
Best regards
Ingolf Dahl
http://web.telia.com/~u31815170/Mathematica/
g = Position[
g0, (Graphics[__] | GraphicsBox[__]), {0, Infinity}];
If[g == {}, g0 === {}, g0 = {g0[[Sequence @@ Sort[g][[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[{}]];
arorg = (AspectRatio /. AbsoluteOptions[g]);
If[arorg === Full, arorg = 1.; g = Show[g, AspectRatio -> 1]];
If[Not[NumberQ[arorg]], 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};
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, (aspectslider = Round[#, 0.001]; #) &@
dh
Hello All,
to prevent the error message produced by graphics containing
"AspectRatio->Full" we may simply replace this option by
"AspectRatio->Automatic".
Here is the changed code:
=========================== Code ===============================
CreatePalette[Button["Zoom",Module[{g,g0,g1,pp1,pp2,arorg},g0=NotebookRead[SelectedNotebook[]];
g=Position[g0,(Graphics[__]|GraphicsBox[__]),{0,Infinity}];
g=g/.(AspectRatio->Full)->(AspectRatio->Automatic);
If[g=={},g0==={},g0={g0[[Sequence@@Sort[g][[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[{}]];
arorg=(AspectRatio/.AbsoluteOptions[g]);
If[arorg===Full,arorg=1.;g=Show[g,AspectRatio->1]];
If[Not[NumberQ[arorg]],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};
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,(aspectslider=Round[#,0.001];#)&@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"];
=============================== Code end ========================
DrMajorBob
"$LocatorPositions = =b" should be "$LocatorPositions=b".
Bobby
On Mon, 12 Nov 2007 04:12:33 -0600, Ingolf Dahl <ingol...@telia.com>
wrote:
> 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"];
>
>
>
>
-- =
Ingolf Dahl
quotes then also appear on the buttons? (Windows XP SP2, Mathematica 6.0.0)
The extra = in the first published version of the code was probably
introduced at a line break by the menu item "Copy As Input Text". Is was
never in my code. There has also been some problems with extra line breaks
in the text strings, introduced somewhere in the copying chain. Please use
now my version 3 (or later), without quotes and extra "=", but with some new
features.
Best regards
Ingolf Dahl
http://web.telia.com/~u31815170/Mathematica/
> -----Original Message-----
> From: DrMajorBob [mailto:drmaj...@bigfoot.com]
> Sent: den 13 november 2007 18:18
> To: Ingolf Dahl; math...@smc.vnet.net
> Subject: Re: Zoom2D and GetGraphicsCoordinates
> palettes combined
>
> Nice, but there were some typos: Button titles lacking
> quotes, and "$LocatorPositions = =b" should be "$LocatorPositions=b".
>
> Bobby
>
> On Mon, 12 Nov 2007 04:12:33 -0600, Ingolf Dahl
> <ingol...@telia.com>
> wrote:
>
> > To MathGroup,
> >
> > Daniel [d...@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).
(snipped)
DrMajorBob
> quotes then also appear on the buttons? (Windows XP SP2, Mathematica
> 6.0.0)
Leaving them out has other strange effects. For instance, evaluating
Copy = 0;
before using your palette results in two of the buttons being labeled 0.
Ditto if graphics = 0, etc.
Even without that, you tried to label one of the buttons "Copy zoomed
graphics", yet it comes out "Copy graphics zoomed" -- with the multiplied
symbols in canonical order.
Anyway, when I add the quotes to your code, they do NOT appear on buttons
at my machine (WinXP SP2, Mathematica 6.0.1.)
Bobby
On Wed, 14 Nov 2007 03:47:46 -0600, Ingolf Dahl <ingol...@telia.com>
wrote:
> Theoretically you are correct about the quotes, but what to do when the
--
Ingolf Dahl
Then I know that this Button issue was a bug in in version 6.0.0, corrected
later. Then it is better to change the code according to your suggestion,
and live with the quotes on the buttons in version 6.0.0.
The idea by Daniel to eliminate "AspectRatio->Full" warning I do not agree
on. This option "Full" specifies that a graphic should be stretched so as to
fill out its enclosing region in a Grid or related construct. If we try to
break the graphics out of the enclosing region, I think it is appropriate
with a warning message, so that the we obtain a hint where to look if the
graphics changes its appearance drastically. The palette works anyway.
"AspectRatio->Automatic" gives unwanted result if the scales on the axes are
very different, so I prefer "AspectRatio->1" as substitute.
Thus version 4 of my code, with quotes, is included at the end of this
letter.
Ingolf Dahl
> >> "$LocatorPositions = =b" should be "$LocatorPositions=b".
> >>
> >> Bobby
> >>
> >> On Mon, 12 Nov 2007 04:12:33 -0600, Ingolf Dahl
> >> <ingol...@telia.com>
> >> wrote:
> >>
> >> > To MathGroup,
> >> >
> >> > Daniel [d...@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).
> > (snipped)
> >
>
> --
> DrMaj...@bigfoot.com
>
Version 4 code:
*******************************************************************
CreatePalette[
Button["Zoom",
Module[{g, g0, g1, pp1, pp2, arorg},
g0 = NotebookRead[SelectedNotebook[]];
g = Position[
g0, (Graphics[__] | GraphicsBox[__]), {0, Infinity}];
If[g == {}, g0 === {}, g0 = {g0[[Sequence @@ Sort[g][[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[{}]];
arorg = (AspectRatio /. AbsoluteOptions[g]);
If[arorg === Full, arorg = 1.; g = Show[g, AspectRatio -> 1]];
If[Not[NumberQ[arorg]], 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};
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, (aspectslider = Round[#, 0.001]; #) &@
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 \