Root/
| 1 | #!/usr/bin/perl |
| 2 | # |
| 3 | # slicer.pl - Standalone STL to Gnuplot slicer |
| 4 | # |
| 5 | # Written 2015 by Werner Almesberger |
| 6 | # Copyright 2015 by Werner Almesberger |
| 7 | # |
| 8 | # This program//library is free software; you can redistribute it and/or |
| 9 | # modify it under the terms of the GNU Lesser General Public |
| 10 | # License as published by the Free Software Foundation; either |
| 11 | # version 2.1 of the License, or (at your option) any later version. |
| 12 | # |
| 13 | |
| 14 | |
| 15 | $epsilon = 0.0001; # cutting offset |
| 16 | $height = undef; # height of workpiece |
| 17 | $margin = undef; # margin of workpiece box |
| 18 | $end = 0; # offset to add at the last layer |
| 19 | $flip = 0; # flip piece |
| 20 | $z_step = undef; # maximum increase of milling depth |
| 21 | |
| 22 | |
| 23 | #----- Command-line processing ------------------------------------------------ |
| 24 | |
| 25 | |
| 26 | sub usage |
| 27 | { |
| 28 | print STDERR <<"EOF"; |
| 29 | usage: $0 [-a (top|bottom)(+|-)offset] [-f] [-h height] |
| 30 | [-m tolerance] [-p piece_distance] [-o z_offset] [-s max_step] [file.stl] |
| 31 | |
| 32 | -a alignment TO DO |
| 33 | -f flip the model around the Y axis |
| 34 | -h height workpiece height (default: use model dimensions) |
| 35 | -m tolerance compatibility with sfc/slicer.py, has no meaning here |
| 36 | -p piece_distance |
| 37 | draw a rectangular workpiece at the specified xy distance |
| 38 | around the model (default: none) |
| 39 | -o z_offset Z adjustment of final layer |
| 40 | -s max_step maximum Z step (default: unlimited) |
| 41 | EOF |
| 42 | exit(1); |
| 43 | } |
| 44 | |
| 45 | |
| 46 | while ($ARGV[0] =~ /^-/) { |
| 47 | my $opt = shift @ARGV; |
| 48 | if ($opt eq "-a") { |
| 49 | # @@@ implement later |
| 50 | shift @ARGV; |
| 51 | } elsif ($opt eq "-f") { |
| 52 | $flip = 1; |
| 53 | } elsif ($opt eq "-h") { |
| 54 | $height = shift @ARGV; |
| 55 | &usage unless defined $height; |
| 56 | } elsif ($opt eq "-m") { |
| 57 | # @@@ not used - support for compatibility |
| 58 | shift @ARGV; |
| 59 | } elsif ($opt eq "-o") { |
| 60 | $end = shift @ARGV; |
| 61 | &usage unless defined $end; |
| 62 | } elsif ($opt eq "-p") { |
| 63 | $margin = shift @ARGV; |
| 64 | &usage unless defined $margin; |
| 65 | } elsif ($opt eq "-s") { |
| 66 | $z_step = shift @ARGV; |
| 67 | &usage unless defined $z_step; |
| 68 | } else { |
| 69 | &usage; |
| 70 | } |
| 71 | } |
| 72 | |
| 73 | |
| 74 | #----- Read the STL mesh ------------------------------------------------------ |
| 75 | |
| 76 | |
| 77 | $xmin = $xmax = $ymin = $ymax = $zmin = $zmax = undef; |
| 78 | |
| 79 | $v_n = 0; |
| 80 | $e_n = 0; |
| 81 | while (<>) { |
| 82 | if (/\bfacet/) { |
| 83 | undef @f; |
| 84 | next; |
| 85 | } |
| 86 | if (/endfacet/) { |
| 87 | if ($f[2] == $f[5] && $f[2] == $f[8]) { |
| 88 | $z_level{$f[2]} = 1; |
| 89 | } else { |
| 90 | push(@m, [ @f ]); |
| 91 | } |
| 92 | next; |
| 93 | } |
| 94 | if (/vertex\s+/) { |
| 95 | my @tmp = split(/\s+/, $'); |
| 96 | |
| 97 | ($tmp[0], $tmp[2]) = (-$tmp[0], -$tmp[2]) if $flip; |
| 98 | |
| 99 | $xmin = $tmp[0] unless defined $xmin && $xmin < $tmp[0]; |
| 100 | $xmax = $tmp[0] unless defined $xmax && $xmax > $tmp[0]; |
| 101 | $ymin = $tmp[1] unless defined $ymin && $ymin < $tmp[1]; |
| 102 | $ymax = $tmp[1] unless defined $ymax && $ymax > $tmp[1]; |
| 103 | $zmin = $tmp[2] unless defined $zmin && $zmin < $tmp[2]; |
| 104 | $zmax = $tmp[2] unless defined $zmax && $zmax > $tmp[2]; |
| 105 | |
| 106 | push(@f, @tmp); |
| 107 | next; |
| 108 | } |
| 109 | } |
| 110 | |
| 111 | print STDERR "bbox\t($xmin, $ymin, $zmin)\n\t($xmax, $ymax, $zmax)\n"; |
| 112 | |
| 113 | |
| 114 | #----- Calculate Z offset ----------------------------------------------------- |
| 115 | |
| 116 | $height = $zmax - $zmin unless defined $height; |
| 117 | |
| 118 | # align with bottom (zmin == 0), z_pos = height - zoff |
| 119 | |
| 120 | $z_off = -$zmin; |
| 121 | $z_pos = $height + $zmin; |
| 122 | |
| 123 | |
| 124 | #----- Perform the slicing ---------------------------------------------------- |
| 125 | |
| 126 | |
| 127 | sub cut |
| 128 | { |
| 129 | local ($z, $a, $b, @f) = @_; |
| 130 | |
| 131 | if ($f[$a + 2] < $z && $f[$b + 2] > $z) { |
| 132 | my $dx = $f[$b] - $f[$a]; |
| 133 | my $dy = $f[$b + 1] - $f[$a + 1]; |
| 134 | my $dz = $f[$b + 2] - $f[$a + 2]; |
| 135 | |
| 136 | my $f = ($z - $f[$a + 2]) / $dz; |
| 137 | return [ $dx * $f + $f[$a], $dy * $f + $f[$a + 1] ]; |
| 138 | } |
| 139 | if ($f[$a + 2] > $z && $f[$b + 2] < $z) { |
| 140 | return &cut($z, $b, $a, @f); |
| 141 | } |
| 142 | return (); |
| 143 | } |
| 144 | |
| 145 | |
| 146 | sub remove |
| 147 | { |
| 148 | local ($a, $b) = @_; |
| 149 | |
| 150 | #print STDERR "\tremove $b from $a (", join(",", @{ $next{$a} }), "\n"; |
| 151 | my @tmp = grep($_ ne $b, @{ $next{$a} }); |
| 152 | if ($#tmp == -1) { |
| 153 | delete $next{$a}; |
| 154 | } else { |
| 155 | $next{$a} = [ @tmp ]; |
| 156 | } |
| 157 | } |
| 158 | |
| 159 | |
| 160 | @z_levels = sort { $b <=> $a } keys %z_level; |
| 161 | for $level (@z_levels) { |
| 162 | my $z_cut = $level + $epsilon; |
| 163 | |
| 164 | print STDERR "level $level (cut at $z_cut)\n"; |
| 165 | |
| 166 | undef %path; |
| 167 | for (@m) { |
| 168 | my @f = @{ $_ }; |
| 169 | my @p = &cut($z_cut, 0, 3, @f); |
| 170 | push(@p, &cut($z_cut, 0, 6, @f)); |
| 171 | push(@p, &cut($z_cut, 3, 6, @f)); |
| 172 | |
| 173 | next if $#p < 1; |
| 174 | die "BAD $#p" if $#p > 1; |
| 175 | |
| 176 | my $a = "$p[0][0] $p[0][1]"; |
| 177 | my $b = "$p[1][0] $p[1][1]"; |
| 178 | push(@{ $path{$a} }, $b); |
| 179 | push(@{ $path{$b} }, $a); |
| 180 | # print STDERR "$z: ($a) to ($b)\n"; |
| 181 | } |
| 182 | |
| 183 | while (1) { |
| 184 | if (defined $z_step) { |
| 185 | $z_pos = $z_pos - $z_step > $level ? |
| 186 | $z_pos - $z_step : $level; |
| 187 | } else { |
| 188 | $z_pos = $level; |
| 189 | } |
| 190 | |
| 191 | my $z = $z_pos + $z_off; |
| 192 | $z += $end if $z_pos == $z_levels[$#z_levels]; |
| 193 | |
| 194 | print STDERR "\t$z_pos @ $z\n"; |
| 195 | if (defined $margin) { |
| 196 | print $xmin - $margin, " ", $ymin - $margin, " $z\n"; |
| 197 | print $xmax + $margin, " ", $ymin - $margin, " $z\n"; |
| 198 | print $xmax + $margin, " ", $ymax + $margin, " $z\n"; |
| 199 | print $xmin - $margin, " ", $ymax + $margin, " $z\n"; |
| 200 | print $xmin - $margin, " ", $ymin - $margin, " $z\n\n"; |
| 201 | } |
| 202 | |
| 203 | %next = %path; |
| 204 | while (1) { |
| 205 | my @k = keys %next; |
| 206 | |
| 207 | last if $#k == -1; |
| 208 | |
| 209 | my $p0 = $k[0]; |
| 210 | $p = $p0; |
| 211 | while (1) { |
| 212 | my $next = $next{$p}[0]; |
| 213 | |
| 214 | print "$p $z\n"; |
| 215 | # print STDERR "at $p\n"; |
| 216 | # print STDERR "\tnext $next\n"; |
| 217 | die "open path" unless defined $next; |
| 218 | &remove($p, $next); |
| 219 | &remove($next, $p); |
| 220 | last if $p0 eq $next; |
| 221 | $p = $next; |
| 222 | } |
| 223 | print "$p0 $z\n"; |
| 224 | print "\n"; |
| 225 | } |
| 226 | |
| 227 | last if $z_pos == $level; |
| 228 | } |
| 229 | } |
| 230 |
Branches:
master
