4
$\begingroup$

I have an image sequence of around 1000 images in a .nb-File which I would like to export to PNG format (1000 images into a folder).

If I use "Save as..." -> "Web page" Mathematica saves the 1000 images in GIF format into a folder named "HTMLFiles" on the Desktop (unfortunately GIF is only 8 Bit). Is it possible to do the same thing, but in 24 Bit PNG (or TIFF, whatever)?

If I select all the 1000 images and try "Save Selection as..." Mathematica tries to make 1 image out of the 1000 images (which I don't need, and also eats up memory and CPU).

The Plots were created with Do[Print[Rasterize[...]], {t, 1, 1000}] and are already finished.

Is it possible to save all the images without having to replot them (the plots were very time intensive) or selecting every single picture by hand and exporting it?

The images are already plotted and rasterized, so the .nb-File looks like this: Screenshot

$\endgroup$
2
$\begingroup$

Here a two ways to save all your notebook graphics to PNG files :

1. Web page with PNG Graphics

This is the quick and indirect way to do that and is actually what you tried. But as you said, by default the exported graphics in the folders are in the GIF format. To Export a notebook to a web page with all the graphics in PNG, this seems to work:

Export["test.html", EvaluationNotebook[], "GraphicsOutput" -> "PNG"]

You have to type the command directly in the notebook containing the pictures (for example at the end of it).

Or if you prefer to run the command from another notebook:

nb = NotebookOpen["your_notebook_file_path"];
Export["test.html", nb, "GraphicsOutput" -> "PNG"]
NotebookClose[nb];

2. Programmatically Export only the graphics

Though I am not really familiar with low level notebook programming, here is some more direct approach I've succeeded to get. It allows to search for all the (2D) graphics in a given notebook and export them to whatever format.

First, as previously, choose the notebook you want:

nb = NotebookOpen["your_notebook_file_path", Visible -> True];

or we can here instead use this demo notebook (from the documentation):

nb = CreateWindow[
   DocumentNotebook[{CellGroup[{TextCell["Text Group", "Section"], 
       TextCell["Mary had a little lamb.", "Text"], 
       TextCell["Its fleece was white as snow.", "Text"]}], 
     CellGroup[{TextCell["Graphics Group", "Section"], 
       ExpressionCell[ Plot[Exp[-x^2], {x, -3, 3}], "Output"], 
       ExpressionCell[ Plot[-x^2, {x, -3, 3}], "Output"]}]}]];

and then run:

SelectionMove[nb, Before, Notebook]; SelectionMove[nb, Next, Cell];
i = 0;
While[(nr = NotebookRead[nb]) =!= {}, 
 If[MatchQ[nr, Cell[BoxData[GraphicsBox[__]], __]],
  i++; Export["test_" <> ToString[i] <> ".png", nr]; Print[i]]; 
 SelectionMove[nb, Next, Cell]]
NotebookClose[nb];

which will print the number of exported graphics as it runs. In your case (1000 graphics) that might be useful to monitor the process. It is easy to adapt the code anyway, in particular to modify the file names (here "test_") and the format of exported graphics (here ".png"). That's it.

Remark: For those which are more familiar with low level notebook programming, i've not been able to use the command SelectionMove[notebook, Next, Graphics] to select iteratively the graphics ... If someone could explain how it exactly works ?

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.