Re: Making nice-looking Legend for Plot
- To: mathgroup at smc.vnet.net
- Subject: [mg89958] Re: Making nice-looking Legend for Plot
- From: lehin.p at gmail.com
- Date: Wed, 25 Jun 2008 06:27:00 -0400 (EDT)
- References: <g35g09$9bm$1@smc.vnet.net> <g3q7hk$aeo$1@smc.vnet.net>
Hello,
I have developed an enhansed version of my program with ability to
export in EMF format without loosing quality! You may also copy the
resulting Plot and pase in Misrosoft Word in native vector format!
More over you may use Unicode characters!
The updated code follows:
(*Creating the Plot*)
expData = {{{{303.15`, 178.9`}, {308.15`, 171.9`}, {313.15`,
164.7`}, {318.15`, 157.8`}, {323.15`, 151}, {333.15`, 137.5`}},
"Author 1"}, {{{313.15`, 165}, {333.15`, 139.5`}, {353.15`,
118.5`}, {373.15`, 101}, {393.15`, 87.2`}, {413.15`,
75.5`}, {433.15`, 65}, {453.15`, 56}, {473.15`, 48}},
"Author 2"}, {{{303.65`, 175.7`}, {305.65`, 172.9`}, {308.15`,
169.7`}, {310.65`, 166.1`}, {313.15`, 162.7`}}, "Author 3"}};
approxData[
T_] := (a + b T + c T^2 + d T^3 /. {a -> 0.15975*10^4,
b -> -0.90451*10^1, c -> 0.18345*10^-1, d -> -0.12998*10^-4}) /;
303 <= T <= 473
a = Plot[Tooltip[approxData[T], "NMA"], {T, 300, 493},
AxesLabel -> {"\!\(\*
StyleBox[\"T\",\nFontSlant->\"Italic\"]\), K", "\[CurlyEpsilon]"}];
b = ListPlot[Thread[Tooltip[##]] & @@@ expData,
PlotMarkers -> {Automatic, 6}];
plot = Show[a, b, PlotRangeClipping -> False, PlotRange -> All];
(*Adding the Legend*)
names = expData[[All, 2]];(*The list of labels of datasets*)
ll = Cases[plot, List[h_, Inset[x_, _], ___] -> Style[x, h],
Infinity];(*extracting the list of PlotMarkers*)
ins = Grid[Table[{ll[[i]], names[[i]]}, {i, 1, Length[ll]}],
Frame -> True, Alignment -> Left];
result = Show[plot, ImageSize -> Medium,
Epilog -> Inset[ins, {450, 160}]]
(*The next section customizes tick lengths*)
TickLengthMultipliers = {3, 3,
3};(*Multipliers for the length of {x,y,z}-ticks*)
myRound =
If[TrueQ[Abs[# - Round[#]] < 2 $MachineEpsilon],
Round[#], #] &;(*Remove the dot "." after integers*)
MyControl =
Show[#, Ticks -> (ticks = (Ticks /. AbsoluteOptions[#, Ticks])[[All,
All, {1, 2, 3}]];
Do[ticks =
MapAt[myRound, ticks,
Table[{j, i, 2}, {i, 1, Length[ticks[[j]]]}]], {j, 1,
Length[ticks]}];
Do[ticks[[j]] =
ticks[[j]] /. {loc_, lab_, len : {_, _}, ___} -> {loc, lab,
TickLengthMultipliers[[j]]*len}, {j, 1, Length[ticks]}];
ticks)] &;
result2 = MyControl[result]
resultForExport =
result2 /.
List[__Tooltip] ->
Sequence[];(*Fix for a bug in exporting ListPlot with Tooltip[]*)
Row[{resultForExport, Spacer[10],
Column[{"You may copy this and paste in Microsoft Word in the \
vector format! Enjoy!",
" More over you may use Unicode characters when exporting to EMF\n
\
or printing (without difficulties!)!"}]}]
(*Exporting the result*)
Export["C:\\1.emf", resultForExport]
Export["C:\\1.pdf", resultForExport]
Export["C:\\1.bmp", resultForExport, ImageResolution -> 300]