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>
- Zoom2D and GetGraphicsCoordinates palettes combined