sl2/slicer.pl |
12 | 12 | # |
13 | 13 | |
14 | 14 | |
15 | | $epsilon = 0.0001; |
| 15 | $epsilon = 0.0001; # cutting offset |
| 16 | $height = 10; # height of workpiece |
| 17 | $margin = 5; # margin of workpiece box |
| 18 | $end = 0; # offset to add at the last layer |
| 19 | $flip = 1; # flip piece |
| 20 | $z0 = -35; # reference tool position |
| 21 | $z_step = 1; |
16 | 22 | |
17 | | $flip = 1; |
18 | 23 | |
| 24 | #----- Read the STL mesh ------------------------------------------------------ |
| 25 | |
| 26 | |
| 27 | $xmin = $xmax = $ymin = $ymax = $zmin = $zmax = undef; |
19 | 28 | |
20 | 29 | $v_n = 0; |
21 | 30 | $e_n = 0; |
... | ... | |
35 | 44 | if (/vertex\s+/) { |
36 | 45 | my @tmp = split(/\s+/, $'); |
37 | 46 | |
38 | | if ($flip) { |
39 | | push(@f, -$tmp[0], $tmp[1], -$tmp[2]); |
40 | | } else { |
41 | | push(@f, @tmp); |
42 | | } |
| 47 | ($tmp[0], $tmp[2]) = (-$tmp[0], -$tmp[2]) if $flip; |
| 48 | |
| 49 | $xmin = $tmp[0] unless defined $xmin && $xmin < $tmp[0]; |
| 50 | $xmax = $tmp[0] unless defined $xmax && $xmax > $tmp[0]; |
| 51 | $ymin = $tmp[1] unless defined $ymin && $ymin < $tmp[1]; |
| 52 | $ymax = $tmp[1] unless defined $ymax && $ymax > $tmp[1]; |
| 53 | $zmin = $tmp[2] unless defined $zmin && $zmin < $tmp[2]; |
| 54 | $zmax = $tmp[2] unless defined $zmax && $zmax > $tmp[2]; |
| 55 | |
| 56 | push(@f, @tmp); |
43 | 57 | next; |
44 | 58 | } |
45 | 59 | } |
46 | 60 | |
| 61 | print STDERR "bbox\t($xmin, $ymin, $zmin)\n\t($xmax, $ymax, $zmax)\n"; |
| 62 | |
| 63 | |
| 64 | #----- Calculate Z offset ----------------------------------------------------- |
| 65 | |
| 66 | # align with bottom (zmin == 0), z_pos = height - zoff |
| 67 | |
| 68 | $z_off = $z0 - $zmin - $height; |
| 69 | $z_pos = $height + $zmin; |
| 70 | |
| 71 | |
| 72 | #----- Perform the slicing ---------------------------------------------------- |
| 73 | |
47 | 74 | |
48 | 75 | sub cut |
49 | 76 | { |
50 | 77 | local ($z, $a, $b, @f) = @_; |
51 | 78 | |
52 | | if ($f[$a + 2] < $z &&$f[$b + 2] > $z) { |
| 79 | if ($f[$a + 2] < $z && $f[$b + 2] > $z) { |
53 | 80 | my $dx = $f[$b] - $f[$a]; |
54 | 81 | my $dy = $f[$b + 1] - $f[$a + 1]; |
55 | 82 | my $dz = $f[$b + 2] - $f[$a + 2]; |
... | ... | |
57 | 84 | my $f = ($z - $f[$a + 2]) / $dz; |
58 | 85 | return [ $dx * $f + $f[$a], $dy * $f + $f[$a + 1] ]; |
59 | 86 | } |
60 | | if ($f[$a + 2] > $z &&$f[$b + 2] < $z) { |
| 87 | if ($f[$a + 2] > $z && $f[$b + 2] < $z) { |
61 | 88 | return &cut($z, $b, $a, @f); |
62 | 89 | } |
63 | 90 | return (); |
... | ... | |
78 | 105 | } |
79 | 106 | |
80 | 107 | |
81 | | for $level (sort keys %z_level) { |
82 | | my $z = $level + $epsilon; |
| 108 | @z_levels = sort { $b <=> $a } keys %z_level; |
| 109 | for $level (@z_levels) { |
| 110 | my $z_cut = $level + $epsilon; |
83 | 111 | |
84 | | # print STDERR "level = $level\n"; |
85 | | undef %next; |
| 112 | print STDERR "level $level (cut at $z_cut)\n"; |
| 113 | |
| 114 | undef %path; |
86 | 115 | for (@m) { |
87 | 116 | my @f = @{ $_ }; |
88 | | my @p = &cut($z, 0, 3, @f); |
89 | | push(@p, &cut($z, 0, 6, @f)); |
90 | | push(@p, &cut($z, 3, 6, @f)); |
| 117 | my @p = &cut($z_cut, 0, 3, @f); |
| 118 | push(@p, &cut($z_cut, 0, 6, @f)); |
| 119 | push(@p, &cut($z_cut, 3, 6, @f)); |
91 | 120 | |
92 | 121 | next if $#p < 1; |
93 | 122 | die "BAD $#p" if $#p > 1; |
94 | 123 | |
95 | 124 | my $a = "$p[0][0] $p[0][1]"; |
96 | 125 | my $b = "$p[1][0] $p[1][1]"; |
97 | | push(@{ $next{$a} }, $b); |
98 | | push(@{ $next{$b} }, $a); |
| 126 | push(@{ $path{$a} }, $b); |
| 127 | push(@{ $path{$b} }, $a); |
99 | 128 | # print STDERR "$z: ($a) to ($b)\n"; |
100 | 129 | } |
101 | 130 | |
102 | 131 | while (1) { |
103 | | my @k = keys %next; |
| 132 | if (defined $z_step) { |
| 133 | $z_pos = $z_pos - $z_step > $level ? |
| 134 | $z_pos - $z_step : $level; |
| 135 | } else { |
| 136 | $z_pos = $level; |
| 137 | } |
| 138 | |
| 139 | my $z = $z_pos + $z_off; |
| 140 | $z += $end if $z_pos == $z_levels[$#z_levels]; |
104 | 141 | |
105 | | last if $#k == -1; |
106 | | my $p0 = $k[0]; |
107 | | $p = $p0; |
| 142 | print STDERR "\t$z_pos @ $z\n"; |
| 143 | if (defined $margin) { |
| 144 | print $xmin - $margin, " ", $ymin - $margin, " $z\n"; |
| 145 | print $xmax + $margin, " ", $ymin - $margin, " $z\n"; |
| 146 | print $xmax + $margin, " ", $ymax + $margin, " $z\n"; |
| 147 | print $xmin - $margin, " ", $ymax + $margin, " $z\n"; |
| 148 | print $xmin - $margin, " ", $ymin - $margin, " $z\n\n"; |
| 149 | } |
| 150 | |
| 151 | %next = %path; |
108 | 152 | while (1) { |
109 | | my $next = $next{$p}[0]; |
110 | | |
111 | | print "$p $z\n"; |
112 | | # print STDERR "at $p\n"; |
113 | | # print STDERR "\tnext $next\n"; |
114 | | die "open path" unless defined $next; |
115 | | &remove($p, $next); |
116 | | &remove($next, $p); |
117 | | last if $p0 eq $next; |
118 | | $p = $next; |
| 153 | my @k = keys %next; |
| 154 | |
| 155 | last if $#k == -1; |
| 156 | |
| 157 | my $p0 = $k[0]; |
| 158 | $p = $p0; |
| 159 | while (1) { |
| 160 | my $next = $next{$p}[0]; |
| 161 | |
| 162 | print "$p $z\n"; |
| 163 | # print STDERR "at $p\n"; |
| 164 | # print STDERR "\tnext $next\n"; |
| 165 | die "open path" unless defined $next; |
| 166 | &remove($p, $next); |
| 167 | &remove($next, $p); |
| 168 | last if $p0 eq $next; |
| 169 | $p = $next; |
| 170 | } |
| 171 | print "$p0 $z\n"; |
| 172 | print "\n"; |
119 | 173 | } |
120 | | print "$p0 $z\n"; |
121 | | print "\n"; |
| 174 | |
| 175 | last if $z_pos == $level; |
122 | 176 | } |
123 | 177 | } |