cae-tools/sl2/slicer.pl

#!/usr/bin/perl
#
# slicer.pl - Standalone STL to Gnuplot slicer
#
# Written 2015 by Werner Almesberger
# Copyright 2015 by Werner Almesberger
#
# This program//library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#


$epsilon = 0.0001;	# cutting offset
$height = undef;	# height of workpiece
$margin = undef;	# margin of workpiece box
$end = 0;		# offset to add at the last layer
$flip = 0;		# flip piece
$z_step = undef;	# maximum increase of milling depth


#----- Command-line processing ------------------------------------------------


sub usage
{
	print STDERR <<"EOF";
usage: $0 [-a (top|bottom)(+|-)offset] [-f] [-h height]
    [-m tolerance] [-p piece_distance] [-o z_offset] [-s max_step] [file.stl]

  -a alignment	TO DO
  -f		flip the model around the Y axis
  -h height	workpiece height (default: use model dimensions)
  -m tolerance	compatibility with sfc/slicer.py, has no meaning here
  -p piece_distance
		draw a rectangular workpiece at the specified xy distance
		around the model (default: none)
  -o z_offset	Z adjustment of final layer
  -s max_step	maximum Z step (default: unlimited)
EOF
	exit(1);
}


while ($ARGV[0] =~ /^-/) {
	my $opt = shift @ARGV;
	if ($opt eq "-a") {
		# @@@ implement later
		shift @ARGV;
	} elsif ($opt eq "-f") {
		$flip = 1;
	} elsif ($opt eq "-h") {
		$height = shift @ARGV;
		&usage unless defined $height;
	} elsif ($opt eq "-m") {
		# @@@ not used - support for compatibility
		shift @ARGV;
	} elsif ($opt eq "-o") {
		$end = shift @ARGV;
		&usage unless defined $end;
	} elsif ($opt eq "-p") {
		$margin = shift @ARGV;
		&usage unless defined $margin;
	} elsif ($opt eq "-s") {
		$z_step = shift @ARGV;
		&usage unless defined $z_step;
	} else {
		&usage;
	}
}


#----- Read the STL mesh ------------------------------------------------------


$xmin = $xmax = $ymin = $ymax = $zmin = $zmax = undef;

$v_n = 0;
$e_n = 0;
while (<>) {
        if (/\bfacet/) {
		undef @f;
                next;
        }
        if (/endfacet/) {
		if ($f[2] == $f[5] && $f[2] == $f[8]) {
			$z_level{$f[2]} = 1;
		} else {
			push(@m, [ @f ]);
		}
                next;
        }
        if (/vertex\s+/) {
		my @tmp = split(/\s+/, $');

		($tmp[0], $tmp[2]) = (-$tmp[0], -$tmp[2]) if $flip;

		$xmin = $tmp[0] unless defined $xmin && $xmin < $tmp[0];
		$xmax = $tmp[0] unless defined $xmax && $xmax > $tmp[0];
		$ymin = $tmp[1] unless defined $ymin && $ymin < $tmp[1];
		$ymax = $tmp[1] unless defined $ymax && $ymax > $tmp[1];
		$zmin = $tmp[2] unless defined $zmin && $zmin < $tmp[2];
		$zmax = $tmp[2] unless defined $zmax && $zmax > $tmp[2];

		push(@f, @tmp);
                next;
        }
}

print STDERR "bbox\t($xmin, $ymin, $zmin)\n\t($xmax, $ymax, $zmax)\n";


#----- Calculate Z offset -----------------------------------------------------

$height = $zmax - $zmin unless defined $height;

# align with bottom (zmin == 0), z_pos = height - zoff

$z_off = -$zmin;
$z_pos = $height + $zmin;


#----- Perform the slicing ----------------------------------------------------


sub cut
{
	local ($z, $a, $b, @f) = @_;

	if ($f[$a + 2] < $z && $f[$b + 2] > $z) {
		my $dx = $f[$b] - $f[$a];
		my $dy = $f[$b + 1] - $f[$a + 1];
		my $dz = $f[$b + 2] - $f[$a + 2];

		my $f = ($z - $f[$a + 2]) / $dz;
		return [ $dx * $f + $f[$a], $dy * $f + $f[$a + 1] ];
	}
	if ($f[$a + 2] > $z && $f[$b + 2] < $z) {
		return &cut($z, $b, $a, @f);
	}
	return ();
}


sub remove
{
	local ($a, $b) = @_;

#print STDERR "\tremove $b from $a (", join(",", @{ $next{$a} }), "\n";
	my @tmp = grep($_ ne $b, @{ $next{$a} });
	if ($#tmp == -1) {
		delete $next{$a};
	} else {
		$next{$a} = [ @tmp ];
	}
}


@z_levels = sort { $b <=> $a } keys %z_level;
for $level (@z_levels) {
	my $z_cut = $level + $epsilon;

	print STDERR "level $level (cut at $z_cut)\n";

	undef %path;
	for (@m) {
		my @f = @{ $_ };
		my @p = &cut($z_cut, 0, 3, @f);
		push(@p, &cut($z_cut, 0, 6, @f));
		push(@p, &cut($z_cut, 3, 6, @f));

		next if $#p < 1;
		die "BAD $#p" if $#p > 1;

		my $a = "$p[0][0] $p[0][1]";
		my $b = "$p[1][0] $p[1][1]";
		push(@{ $path{$a} }, $b);
		push(@{ $path{$b} }, $a);
#		print STDERR "$z: ($a) to ($b)\n";
	}

	while (1) {
		if (defined $z_step) {
			$z_pos = $z_pos - $z_step > $level ?
			    $z_pos - $z_step : $level;
		} else {
			$z_pos = $level;
		}

		my $z = $z_pos + $z_off;
		$z += $end if $z_pos == $z_levels[$#z_levels];

		print STDERR "\t$z_pos @ $z\n";
		if (defined $margin) {
			print $xmin - $margin, " ", $ymin - $margin, " $z\n";
			print $xmax + $margin, " ", $ymin - $margin, " $z\n";
			print $xmax + $margin, " ", $ymax + $margin, " $z\n";
			print $xmin - $margin, " ", $ymax + $margin, " $z\n";
			print $xmin - $margin, " ", $ymin - $margin, " $z\n\n";
		}

		%next = %path;
		while (1) {
			my @k = keys %next;

			last if $#k == -1;

			my $p0 = $k[0];
			$p = $p0;
			while (1) {
				my $next = $next{$p}[0];

				print "$p $z\n";
#				print STDERR "at $p\n";
#				print STDERR "\tnext $next\n";
				die "open path" unless defined $next;	
				&remove($p, $next);
				&remove($next, $p);
				last if $p0 eq $next;
				$p = $next;
			}
			print "$p0 $z\n";
			print "\n";
		}

		last if $z_pos == $level;
	}
}