Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Version 3: Zoom2D and GetGraphicsCoordinates palettes combined

• To: mathgroup at smc.vnet.net
• Subject: [mg83176] Re: Version 3: Zoom2D and GetGraphicsCoordinates palettes combined
• From: dh <dh at metrohm.ch>
• Date: Wed, 14 Nov 2007 04:41:42 -0500 (EST)
• References: <200711121012.FAA10954@smc.vnet.net> <fhc3vl$53b$1@smc.vnet.net>

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 ========================



Ingolf Dahl wrote:

> Maybe The Moderator manages to stop my previous post...

> 

> 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

> 

• References:
  • Zoom2D and GetGraphicsCoordinates palettes combined
    • From: "Ingolf Dahl" <ingolf.dahl@telia.com>