3D Paper Physical Models

 Recently John May wrote about exporting 3D plots to Minecraft. This takes one virtual form of a plot and converts it to a different virtual form. To take the idea a step further, how about exporting 3D plots to real physical models that you can hold in your hand? This makes a great back-to-school project.

Seeing this example of a "creative paper contraption"inspired me to spend an hour writing code to slice up plots in Maple. The concept is simple, just iterate through fixed values of x and generate some plot slices. In practice there are a couple optimizations that really help when it comes down to applying the scissors.

The basic algorithm builds out of the following, which simply takes slices of a nice looking plot.

	f := sin(sqrt(x^2+y^2))/sqrt(x^2+y^2);
	xrange := -10 .. 10;
	yrange := -10 .. 10;

	for x from lhs(xrange) to rhs(xrange) by .66 do
	    plot(f,y=yrange);
	end do;

These could be cut out on their own except for the fact that Maple scales the z-axis to maximize the viewing area of the curve. Adding scaling=constrained accounts for this, but results in plots that are too flat. We'll use plottools:-getdata to find the extents of the z view in the original 3D plot, and then use this to scale up the slices to fill the viewable are of the plot. Further, we'll also use this to draw a bounding box around the plot, leaving room for a base that will keep each curve together when you cut it out.

        unassign('x'):
	p := plot3d(f, 'x' = xrange, 'y' = yrange):
	init_zrange := plottools:-getdata(p,element="grid")[2][3];
	zscale := (rhs(xrange) - lhs(xrange)) / (rhs(init_zrange) - lhs(init_zrange));
	zrange := zscale*2 * lhs(init_zrange) .. zscale * rhs(init_zrange);
	F := unapply(zscale*f,'x','y');

 

The last bit of tricky business is to draw cut lines. These should appear from the bottom up on the x-slices, and from the top down on the y-slices. They should extend half way between the curve and base so that the x and y slices slide together at the intersection and provide a stable platform. We'll pre generate the set of points for both x and y because both are needed in all plots.

	num_xslices := 20:
	xset := seq(x,x=xrange,(rhs(xrange)-lhs(xrange))/(num_xslices-1));
	num_yslices := 2:
	yset := seq(y,y=yrange,(rhs(yrange)-lhs(yrange))/(num_yslices+1))[2..-2];

I tried two different plots, one with 20 slices, and a second with 30 slices. The one with fewer slices was easier to put together and looked good. The one with more slices was more than proportionally longer to cut out and join together. The narrow margins made it stiffer and hard to work with. The final result wasn't particularly better.

Here is the code for generating the x slices. There are 4 groups of plots in this command:

• plot of the curve (slice)
• plot of the vertical cut lines
• plot of the bounding box
• label for each plot

The plot labels are especially useful if you mix up the order of the cut-outs. It's also nice to see the equation written on the front and side.

	unassign('x'); unassign('y');
	for x in xset do
	  plots[display](
	    plot(F(x,y),'y'=yrange),
	    seq(plots[pointplot]( [[y,lhs(zrange)],[y,F(x,y)-abs(F(x,y)-lhs(zrange))/2]], connect=true ), y in yset),
	    plots[polygonplot]( [[lhs(yrange),lhs(zrange)],[lhs(yrange),rhs(zrange)],
				 [lhs(yrange),rhs(zrange)],[rhs(yrange),rhs(zrange)],
				 [rhs(yrange),rhs(zrange)],[rhs(yrange),lhs(zrange)],
				 [rhs(yrange),lhs(zrange)],[lhs(yrange),lhs(zrange)]],style=line),
	    plots[textplot]([yset[1]+(yset[2]-yset[1])/2,lhs(zrange)+(F(x,yset[1])-lhs(zrange))/2,
		    `if`(x=xset[1],typeset(eval(f,1)),sprintf("x=%a",x))]),
	    axes=none,scaling=constrained);
	end do;
 




(17 more plots; etc...)

The y-slice code is almost identical to the x-slices. One difference is that we don't generate plots at the edges of the view. When cutting these out, leave extra room at the left and right sides so the x-slices aren't falling off the edge.

	unassign('x'); unassign('y'); 
        n := floor(numelems([xset])/2):
	for y in yset do
	  plots[display](
	    plot(F(x,y),'x'=xrange),
	    seq(plots[pointplot]( [[x,lhs(zrange)+abs(F(x,y)-lhs(zrange))/2],[x,F(x,y)]], connect=true ), x in xset),
	    plots[polygonplot]( [[lhs(xrange),lhs(zrange)],[lhs(xrange),rhs(zrange)],
				 [lhs(xrange),rhs(zrange)],[rhs(xrange),rhs(zrange)],
				 [rhs(xrange),rhs(zrange)],[rhs(xrange),lhs(zrange)],
				 [rhs(xrange),lhs(zrange)],[lhs(xrange),lhs(zrange)]],style=line),
	    plots[textplot]([xset[n]+(xset[n+1]-xset[n])/2,lhs(zrange)+(F(xset[n],y)-lhs(zrange))/2,
		     `if`(y=yset[1],typeset(eval(f,1)),sprintf("y=%a",y))]),
	    axes=none,scaling=constrained);
	end do;


 

The full worksheet can be found here:

PaperPlot.mw