(* :Title: PagePrint *) (* :Author: Mark Fisher *) (* :Date: December 2004 January 2005 modified ExportString format: If[$VersionNumber >= 5.1, "APS", "MPS"] *) (* :References: Adapted from code written at my request by John Fultz, jfultz@wolfram.com *) (* :Warning: The option LandscapeOrientation and the paper orientation of the printer must agree in order to get the correct result. You can use PagePrint[] to set the paper orientation. In principle the notebook option PrintingOptions -> {"PaperOrientation" -> "Landscape"} could be used to control this behavior, but the option does not work (a known bug). *) PagePrint::usage = "PagePrint[graphic, opts] prints the graphic on a blank page. The option LandscapeOrientation can be either True or False (default). Run PagePrint[] to set the page orientation of the printer to correspond to the option setting (and to select which printer to use). The option PageMargins specifies the page margins in inches. The default is 1 (inch). The image is resized to fill the space within the margins. The option ImageDimensions is ignored with the default setting Automatic. Setting ImageDimensions -> {w, h} overrides the PageMargins option and place the image in a centered rectangle (w \[Times] h) inches. Setting ImageDimensions -> w effectively specifies {w, w * ar}, where ar is the aspect ratio of the graphic. Finally, the option PaperDimensions can be used to specify the dimensions of the paper (in inches). The default is PaperDimensions -> {8.5, 11}. Note: Because printer often shrink-to-fit images within their printable area (which is typically smaller than the page size), The printed image may be about 5 percent smaller than specified." Options[PagePrint] = { LandscapeOrientation -> False, PageMargins -> 1, ImageDimensions -> Automatic, PaperDimensions -> {8.5, 11} } PagePrint[] := FrontEndExecute[FrontEndToken["SystemPrintOptionsDialog"]] PagePrint[x_, opts___] := Module[{pdim, land, marg, idem, page, p, imarg, pOnPage, nb}, (* setup the page *) {pdim, land, marg, idim} = {PaperDimensions, LandscapeOrientation, PageMargins, ImageDimensions} /. {opts} /. Options[PagePrint]; If[TrueQ[land], pdim = Reverse[pdim]]; page = Graphics[Rectangle[{0,0}, pdim, Graphics[{}]], AspectRatio -> Automatic]; If[TrueQ[idim == Automatic], (* then use PageMargins *) p = Graphics[Rectangle[marg {1,1}, pdim - marg {1,1}, x]], (* else use ImageDimensions *) If[NumericQ[idim], idim = idim {1, AspectRatio /. AbsoluteOptions[x]}]; imarg = (pdim - idim)/2; p = Graphics[Rectangle[imarg * {1,1}, pdim - imarg * {1,1}, x]] ]; pOnPage = Show[page, p, DisplayFunction -> Identity]; (* setup the notebook *) nb = NotebookCreate[ Visible -> False, PrintingOptions -> { "FirstPageHeader" -> False, "FirstPageFooter" -> False, "RestPagesHeader" -> False, "RestPagesFooter" -> False, "PrintingMargins" -> {{0,0},{0,0}} }]; NotebookWrite[nb, Cell[GraphicsData["PostScript", ExportString[pOnPage, If[$VersionNumber >= 5.1, "APS", "MPS"]]], "Graphics", Magnification -> 1, (* this fixes the 80% problem *) ImageSize -> 72 * pdim, ImageMargins -> {{0,0},{0,0}}, CellMargins -> {{0,0},{0,0}} ] ]; NotebookPrint[nb]; NotebookClose[nb] ]