TriangleMesh.pm 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581
  1. package Slic3r::TriangleMesh;
  2. use Moo;
  3. use Slic3r::Geometry qw(X Y Z A B unscale same_point);
  4. # public
  5. has 'vertices' => (is => 'ro', required => 1); # id => [$x,$y,$z]
  6. has 'facets' => (is => 'ro', required => 1); # id => [ $v1_id, $v2_id, $v3_id ]
  7. # private
  8. has 'edges' => (is => 'ro', default => sub { [] }); # id => [ $v1_id, $v2_id ]
  9. has 'facets_edges' => (is => 'ro', default => sub { [] }); # id => [ $e1_id, $e2_id, $e3_id ]
  10. has 'edges_facets' => (is => 'ro', default => sub { [] }); # id => [ $f1_id, $f2_id, (...) ]
  11. use constant MIN => 0;
  12. use constant MAX => 1;
  13. use constant I_FMT => 'ffllLllc';
  14. use constant I_B => 0;
  15. use constant I_A_ID => 1;
  16. use constant I_B_ID => 2;
  17. use constant I_FACET_INDEX => 3;
  18. use constant I_PREV_FACET_INDEX => 4;
  19. use constant I_NEXT_FACET_INDEX => 5;
  20. use constant I_FACET_EDGE => 6;
  21. use constant FE_TOP => 0;
  22. use constant FE_BOTTOM => 1;
  23. # always make sure BUILD is idempotent
  24. sub BUILD {
  25. my $self = shift;
  26. @{$self->edges} = ();
  27. @{$self->facets_edges} = ();
  28. @{$self->edges_facets} = ();
  29. my %table = (); # edge_coordinates => edge_id
  30. for (my $facet_id = 0; $facet_id <= $#{$self->facets}; $facet_id++) {
  31. my $facet = $self->facets->[$facet_id];
  32. $self->facets_edges->[$facet_id] = [];
  33. # reorder vertices so that the first one is the one with lowest Z
  34. # this is needed to get all intersection lines in a consistent order
  35. # (external on the right of the line)
  36. {
  37. my @z_order = sort { $self->vertices->[$facet->[$a]][Z] <=> $self->vertices->[$facet->[$b]][Z] } -3..-1;
  38. @$facet[-3..-1] = (@$facet[$z_order[0]..-1], @$facet[-3..($z_order[0]-1)]);
  39. }
  40. # ignore the normal if provided
  41. my @vertices = @$facet[-3..-1];
  42. foreach my $edge ($self->_facet_edges($facet_id)) {
  43. my $edge_coordinates = join ';', sort @$edge;
  44. my $edge_id = $table{$edge_coordinates};
  45. if (!defined $edge_id) {
  46. # Note that the order of vertices in $self->edges is *casual* because it is only
  47. # good for one of the two adjacent facets. For this reason, it must not be used
  48. # when dealing with single facets.
  49. push @{$self->edges}, $edge;
  50. $edge_id = $#{$self->edges};
  51. $table{$edge_coordinates} = $edge_id;
  52. $self->edges_facets->[$edge_id] = [];
  53. }
  54. push @{$self->facets_edges->[$facet_id]}, $edge_id;
  55. push @{$self->edges_facets->[$edge_id]}, $facet_id;
  56. }
  57. }
  58. }
  59. sub merge {
  60. my $class = shift;
  61. my @meshes = @_;
  62. my $vertices = [];
  63. my $facets = [];
  64. foreach my $mesh (@meshes) {
  65. my $v_offset = @$vertices;
  66. push @$vertices, @{$mesh->vertices};
  67. push @$facets, map {
  68. my $f = [@$_];
  69. $f->[$_] += $v_offset for -3..-1;
  70. $f;
  71. } @{$mesh->facets};
  72. }
  73. return $class->new(vertices => $vertices, facets => $facets);
  74. }
  75. sub clone {
  76. my $self = shift;
  77. return (ref $self)->new(
  78. vertices => [ map [ @$_ ], @{$self->vertices} ],
  79. facets => [ map [ @$_ ], @{$self->facets} ],
  80. );
  81. }
  82. sub _facet_edges {
  83. my $self = shift;
  84. my ($facet_id) = @_;
  85. my $facet = $self->facets->[$facet_id];
  86. return (
  87. [ $facet->[-3], $facet->[-2] ],
  88. [ $facet->[-2], $facet->[-1] ],
  89. [ $facet->[-1], $facet->[-3] ],
  90. );
  91. }
  92. # This method is supposed to remove narrow triangles, but it actually doesn't
  93. # work much; I'm committing it for future reference but I'm going to remove it later.
  94. # Note: a 'clean' method should actually take care of non-manifold facets and remove
  95. # them.
  96. sub clean {
  97. my $self = shift;
  98. # retrieve all edges shared by more than two facets;
  99. my @weird_edges = grep { @{$self->edge_facets->{$_}} != 2 } keys %{$self->edge_facets};
  100. # usually most of these facets are very narrow triangles whose two edges
  101. # are detected as collapsed, and thus added twice to the edge in edge_fasets table
  102. # let's identify these triangles
  103. my @narrow_facets_indexes = ();
  104. foreach my $edge_id (@weird_edges) {
  105. my %facet_count = ();
  106. $facet_count{$_}++ for @{$self->edge_facets->{$edge_id}};
  107. @{$self->edge_facets->{$edge_id}} = grep $facet_count{$_} == 1, keys %facet_count;
  108. push @narrow_facets_indexes, grep $facet_count{$_} > 1, keys %facet_count;
  109. }
  110. # remove identified narrow facets
  111. foreach my $facet_id (@narrow_facets_indexes) {last;
  112. splice @{$self->facets}, $facet_id, 1;
  113. splice @{$self->facets_edges}, $facet_id, 1;
  114. foreach my $facet_ides (values %{$self->edge_facets}) {
  115. @$facet_ides = map { $_ > $facet_id ? ($_-1) : $_ } @$facet_ides;
  116. }
  117. }
  118. Slic3r::debugf "%d narrow facets removed\n", scalar(@narrow_facets_indexes)
  119. if @narrow_facets_indexes;
  120. }
  121. sub check_manifoldness {
  122. my $self = shift;
  123. # look for any edges not connected to exactly two facets
  124. my ($first_bad_edge_id) =
  125. grep { @{ $self->edges_facets->[$_] } != 2 } 0..$#{$self->edges_facets};
  126. if (defined $first_bad_edge_id) {
  127. warn sprintf "Warning: The input file contains a hole near edge %f-%f (not manifold). "
  128. . "You might want to repair it and retry, or to check the resulting G-code before printing anyway.\n",
  129. @{$self->edges->[$first_bad_edge_id]};
  130. return 0;
  131. }
  132. return 1;
  133. }
  134. sub unpack_line {
  135. my ($packed) = @_;
  136. my @data = unpack I_FMT, $packed;
  137. splice @data, 0, 2, [ @data[0,1] ];
  138. $data[$_] = undef for grep $data[$_] == -1, I_A_ID, I_B_ID, I_FACET_EDGE, I_PREV_FACET_INDEX, I_NEXT_FACET_INDEX;
  139. return [@data];
  140. }
  141. sub make_loops {
  142. my ($lines) = @_;
  143. my @lines = map unpack_line($_), @$lines;
  144. # remove tangent edges
  145. {
  146. for (my $i = 0; $i <= $#lines; $i++) {
  147. next unless defined $lines[$i] && defined $lines[$i][I_FACET_EDGE];
  148. # if the line is a facet edge, find another facet edge
  149. # having the same endpoints but in reverse order
  150. for (my $j = $i+1; $j <= $#lines; $j++) {
  151. next unless defined $lines[$j] && defined $lines[$j][I_FACET_EDGE];
  152. # are these facets adjacent? (sharing a common edge on this layer)
  153. if ($lines[$i][I_A_ID] == $lines[$j][I_B_ID] && $lines[$i][I_B_ID] == $lines[$j][I_A_ID]) {
  154. # if they are both oriented upwards or downwards (like a 'V')
  155. # then we can remove both edges from this layer since it won't
  156. # affect the sliced shape
  157. if ($lines[$j][I_FACET_EDGE] == $lines[$i][I_FACET_EDGE]) {
  158. $lines[$i] = undef;
  159. $lines[$j] = undef;
  160. last;
  161. }
  162. # if one of them is oriented upwards and the other is oriented
  163. # downwards, let's only keep one of them (it doesn't matter which
  164. # one since all 'top' lines were reversed at slicing)
  165. if ($lines[$i][I_FACET_EDGE] == FE_TOP && $lines[$j][I_FACET_EDGE] == FE_BOTTOM) {
  166. $lines[$j] = undef;
  167. last;
  168. }
  169. }
  170. }
  171. }
  172. }
  173. @lines = grep $_, @lines;
  174. # count relationships
  175. my %prev_count = (); # how many lines have the same prev_facet_index
  176. my %a_count = (); # how many lines have the same a_id
  177. foreach my $line (@lines) {
  178. if (defined $line->[I_PREV_FACET_INDEX]) {
  179. $prev_count{$line->[I_PREV_FACET_INDEX]}++;
  180. }
  181. if (defined $line->[I_A_ID]) {
  182. $a_count{$line->[I_A_ID]}++;
  183. }
  184. }
  185. foreach my $point_id (grep $a_count{$_} > 1, keys %a_count) {
  186. my @lines_starting_here = grep defined $_->[I_A_ID] && $_->[I_A_ID] == $point_id, @lines;
  187. Slic3r::debugf "%d lines start at point %d\n", scalar(@lines_starting_here), $point_id;
  188. # if two lines start at this point, one being a 'top' facet edge and the other being a 'bottom' one,
  189. # then remove the top one and those following it (removing the top or the bottom one is an arbitrary
  190. # choice)
  191. # The "// ''" on the next line avoids uninitialized value errors mentioned in issue #357 but these
  192. # errors occur on fixed models so the root cause still needs to be found
  193. if (@lines_starting_here == 2 && join('', sort map $_->[I_FACET_EDGE] // '', @lines_starting_here) eq FE_TOP.FE_BOTTOM) { #/
  194. my @to_remove = grep $_->[I_FACET_EDGE] == FE_TOP, @lines_starting_here;
  195. while (!grep defined $_->[I_B_ID] && $_->[I_B_ID] == $to_remove[-1]->[I_B_ID] && $_ ne $to_remove[-1], @lines) {
  196. push @to_remove, grep defined $_->[I_A_ID] && $_->[I_A_ID] == $to_remove[-1]->[I_B_ID], @lines;
  197. }
  198. my %to_remove = map {$_ => 1} @to_remove;
  199. @lines = grep !$to_remove{$_}, @lines;
  200. } else {
  201. Slic3r::debugf " this shouldn't happen and should be further investigated\n";
  202. if (0) {
  203. require "Slic3r/SVG.pm";
  204. Slic3r::SVG::output("same_point.svg",
  205. lines => [ map $_->line, grep !defined $_->[I_FACET_EDGE], @lines ],
  206. red_lines => [ map $_->line, grep defined $_->[I_FACET_EDGE], @lines ],
  207. #points => [ $self->vertices->[$point_id] ],
  208. no_arrows => 0,
  209. );
  210. }
  211. }
  212. }
  213. # optimization: build indexes of lines
  214. my %by_facet_index = map { $lines[$_][I_FACET_INDEX] => $_ }
  215. grep defined $lines[$_][I_FACET_INDEX],
  216. (0..$#lines);
  217. my %by_a_id = map { $lines[$_][I_A_ID] => $_ }
  218. grep defined $lines[$_][I_A_ID],
  219. (0..$#lines);
  220. my (@polygons, @failed_loops, %visited_lines) = ();
  221. my $slicing_errors = 0;
  222. CYCLE: for (my $i = 0; $i <= $#lines; $i++) {
  223. my $line = $lines[$i];
  224. next if $visited_lines{$line};
  225. my @points = ();
  226. my $first_facet_index = $line->[I_FACET_INDEX];
  227. do {
  228. my $next_line;
  229. if (defined $line->[I_NEXT_FACET_INDEX] && exists $by_facet_index{$line->[I_NEXT_FACET_INDEX]}) {
  230. $next_line = $lines[$by_facet_index{$line->[I_NEXT_FACET_INDEX]}];
  231. } elsif (defined $line->[I_B_ID] && exists $by_a_id{$line->[I_B_ID]}) {
  232. $next_line = $lines[$by_a_id{$line->[I_B_ID]}];
  233. } else {
  234. Slic3r::debugf " line has no next_facet_index or b_id\n";
  235. $slicing_errors = 1;
  236. push @failed_loops, [@points] if @points;
  237. next CYCLE;
  238. }
  239. if (!$next_line || $visited_lines{$next_line}) {
  240. Slic3r::debugf " failed to close this loop\n";
  241. $slicing_errors = 1;
  242. push @failed_loops, [@points] if @points;
  243. next CYCLE;
  244. } elsif (defined $next_line->[I_PREV_FACET_INDEX] && $next_line->[I_PREV_FACET_INDEX] != $line->[I_FACET_INDEX]) {
  245. Slic3r::debugf " wrong prev_facet_index\n";
  246. $slicing_errors = 1;
  247. push @failed_loops, [@points] if @points;
  248. next CYCLE;
  249. } elsif (defined $next_line->[I_A_ID] && $next_line->[I_A_ID] != $line->[I_B_ID]) {
  250. Slic3r::debugf " wrong a_id\n";
  251. $slicing_errors = 1;
  252. push @failed_loops, [@points] if @points;
  253. next CYCLE;
  254. }
  255. push @points, $next_line->[I_B];
  256. $visited_lines{$next_line} = 1;
  257. $line = $next_line;
  258. } while ($first_facet_index != $line->[I_FACET_INDEX]);
  259. push @polygons, Slic3r::Polygon->new(@points);
  260. Slic3r::debugf " Discovered %s polygon of %d points\n",
  261. ($polygons[-1]->is_counter_clockwise ? 'ccw' : 'cw'), scalar(@points)
  262. if $Slic3r::debug;
  263. }
  264. # TODO: we should try to combine failed loops
  265. for (grep @$_ >= 3, @failed_loops) {
  266. push @polygons, Slic3r::Polygon->new(@$_);
  267. Slic3r::debugf " Discovered failed %s polygon of %d points\n",
  268. ($polygons[-1]->is_counter_clockwise ? 'ccw' : 'cw'), scalar(@$_)
  269. if $Slic3r::debug;
  270. }
  271. return ($slicing_errors, [@polygons]);
  272. }
  273. sub rotate {
  274. my $self = shift;
  275. my ($deg) = @_;
  276. return if $deg == 0;
  277. my $rad = Slic3r::Geometry::deg2rad($deg);
  278. # transform vertex coordinates
  279. foreach my $vertex (@{$self->vertices}) {
  280. @$vertex = (@{ +(Slic3r::Geometry::rotate_points($rad, undef, [ $vertex->[X], $vertex->[Y] ]))[0] }, $vertex->[Z]);
  281. }
  282. }
  283. sub scale {
  284. my $self = shift;
  285. my ($factor) = @_;
  286. return if $factor == 1;
  287. # transform vertex coordinates
  288. foreach my $vertex (@{$self->vertices}) {
  289. $vertex->[$_] *= $factor for X,Y,Z;
  290. }
  291. }
  292. sub move {
  293. my $self = shift;
  294. my (@shift) = @_;
  295. # transform vertex coordinates
  296. foreach my $vertex (@{$self->vertices}) {
  297. $vertex->[$_] += $shift[$_] || 0 for X,Y,Z;
  298. }
  299. }
  300. sub align_to_origin {
  301. my $self = shift;
  302. # calculate the displacements needed to
  303. # have lowest value for each axis at coordinate 0
  304. my @extents = $self->extents;
  305. $self->move(map -$extents[$_][MIN], X,Y,Z);
  306. }
  307. sub duplicate {
  308. my $self = shift;
  309. my (@shifts) = @_;
  310. my @new_facets = ();
  311. foreach my $facet (@{$self->facets}) {
  312. # transform vertex coordinates
  313. my ($normal, @vertices) = @$facet;
  314. foreach my $shift (@shifts) {
  315. push @new_facets, [ $normal ];
  316. foreach my $vertex (@vertices) {
  317. push @{$self->vertices}, [ map $self->vertices->[$vertex][$_] + ($shift->[$_] || 0), (X,Y,Z) ];
  318. push @{$new_facets[-1]}, $#{$self->vertices};
  319. }
  320. }
  321. }
  322. push @{$self->facets}, @new_facets;
  323. $self->BUILD;
  324. }
  325. sub extents {
  326. my $self = shift;
  327. return Slic3r::Geometry::bounding_box_3D($self->vertices);
  328. }
  329. sub size {
  330. my $self = shift;
  331. return Slic3r::Geometry::size_3D($self->vertices);
  332. }
  333. sub slice_facet {
  334. my $self = shift;
  335. my ($print_object, $facet_id) = @_;
  336. my @vertices = @{$self->facets->[$facet_id]}[-3..-1];
  337. Slic3r::debugf "\n==> FACET %d (%f,%f,%f - %f,%f,%f - %f,%f,%f):\n",
  338. $facet_id, map @{$self->vertices->[$_]}, @vertices
  339. if $Slic3r::debug;
  340. # find the vertical extents of the facet
  341. my ($min_z, $max_z) = (99999999999, -99999999999);
  342. foreach my $vertex (@vertices) {
  343. my $vertex_z = $self->vertices->[$vertex][Z];
  344. $min_z = $vertex_z if $vertex_z < $min_z;
  345. $max_z = $vertex_z if $vertex_z > $max_z;
  346. }
  347. Slic3r::debugf "z: min = %.0f, max = %.0f\n", $min_z, $max_z;
  348. if ($max_z == $min_z) {
  349. Slic3r::debugf "Facet is horizontal; ignoring\n";
  350. return;
  351. }
  352. # calculate the layer extents
  353. my $min_layer = int((unscale($min_z) - ($Slic3r::Config->get_value('first_layer_height') + $Slic3r::Config->layer_height / 2)) / $Slic3r::Config->layer_height) - 2;
  354. $min_layer = 0 if $min_layer < 0;
  355. my $max_layer = int((unscale($max_z) - ($Slic3r::Config->get_value('first_layer_height') + $Slic3r::Config->layer_height / 2)) / $Slic3r::Config->layer_height) + 2;
  356. Slic3r::debugf "layers: min = %s, max = %s\n", $min_layer, $max_layer;
  357. my $lines = {}; # layer_id => [ lines ]
  358. for (my $layer_id = $min_layer; $layer_id <= $max_layer; $layer_id++) {
  359. my $layer = $print_object->layer($layer_id);
  360. $lines->{$layer_id} ||= [];
  361. push @{ $lines->{$layer_id} }, $self->intersect_facet($facet_id, $layer->slice_z);
  362. }
  363. return $lines;
  364. }
  365. sub intersect_facet {
  366. my $self = shift;
  367. my ($facet_id, $z) = @_;
  368. my @vertices_ids = @{$self->facets->[$facet_id]}[-3..-1];
  369. my @edge_ids = @{$self->facets_edges->[$facet_id]};
  370. my @edge_vertices_ids = $self->_facet_edges($facet_id);
  371. my (@lines, @points, @intersection_points, @points_on_layer) = ();
  372. for my $e (0..2) {
  373. my $edge_id = $edge_ids[$e];
  374. my ($a_id, $b_id) = @{$edge_vertices_ids[$e]};
  375. my ($a, $b) = map $self->vertices->[$_], ($a_id, $b_id);
  376. #printf "Az = %f, Bz = %f, z = %f\n", $a->[Z], $b->[Z], $z;
  377. if ($a->[Z] == $b->[Z] && $a->[Z] == $z) {
  378. # edge is horizontal and belongs to the current layer
  379. my $edge_type = (grep $self->vertices->[$_][Z] < $z, @vertices_ids) ? FE_TOP : FE_BOTTOM;
  380. if ($edge_type == FE_TOP) {
  381. ($a, $b) = ($b, $a);
  382. ($a_id, $b_id) = ($b_id, $a_id);
  383. }
  384. push @lines, pack I_FMT, (
  385. $b->[X], $b->[Y], # I_B
  386. $a_id, # I_A_ID
  387. $b_id, # I_B_ID
  388. $facet_id, # I_FACET_INDEX
  389. -1, # I_PREV_FACET_INDEX
  390. -1, # I_NEXT_FACET_INDEX
  391. $edge_type, # I_FACET_EDGE
  392. # Unused data:
  393. # a => [$a->[X], $a->[Y]],
  394. );
  395. #print "Horizontal edge at $z!\n";
  396. } elsif ($a->[Z] == $z) {
  397. #print "A point on plane $z!\n";
  398. push @points, [ $a->[X], $a->[Y], $a_id ];
  399. push @points_on_layer, $#points;
  400. } elsif ($b->[Z] == $z) {
  401. #print "B point on plane $z!\n";
  402. push @points, [ $b->[X], $b->[Y], $b_id ];
  403. push @points_on_layer, $#points;
  404. } elsif (($a->[Z] < $z && $b->[Z] > $z) || ($b->[Z] < $z && $a->[Z] > $z)) {
  405. # edge intersects the current layer; calculate intersection
  406. push @points, [
  407. $b->[X] + ($a->[X] - $b->[X]) * ($z - $b->[Z]) / ($a->[Z] - $b->[Z]),
  408. $b->[Y] + ($a->[Y] - $b->[Y]) * ($z - $b->[Z]) / ($a->[Z] - $b->[Z]),
  409. undef,
  410. $edge_id,
  411. ];
  412. push @intersection_points, $#points;
  413. #print "Intersects at $z!\n";
  414. }
  415. }
  416. return @lines if @lines;
  417. if (@points_on_layer == 2 && @intersection_points == 1) {
  418. $points[ $points_on_layer[1] ] = undef;
  419. @points = grep $_, @points;
  420. }
  421. if (@points_on_layer == 2 && @intersection_points == 0) {
  422. if (same_point(map $points[$_], @points_on_layer)) {
  423. return ();
  424. }
  425. }
  426. if (@points) {
  427. # defensive programming:
  428. die "Facets must intersect each plane 0 or 2 times" if @points != 2;
  429. # connect points:
  430. my ($prev_facet_index, $next_facet_index) = (undef, undef);
  431. $prev_facet_index = +(grep $_ != $facet_id, @{$self->edges_facets->[$points[B][3]]})[0]
  432. if defined $points[B][3];
  433. $next_facet_index = +(grep $_ != $facet_id, @{$self->edges_facets->[$points[A][3]]})[0]
  434. if defined $points[A][3];
  435. return pack I_FMT, (
  436. $points[A][X], $points[A][Y], # I_B
  437. $points[B][2] // -1, # I_A_ID /
  438. $points[A][2] // -1, # I_B_ID /
  439. $facet_id, # I_FACET_INDEX
  440. $prev_facet_index // -1, # I_PREV_FACET_INDEX /
  441. $next_facet_index // -1, # I_NEXT_FACET_INDEX /
  442. -1, # I_FACET_EDGE
  443. );
  444. #printf " intersection points at z = %f: %f,%f - %f,%f\n", $z, map @$_, @intersection_points;
  445. }
  446. return ();
  447. }
  448. sub get_connected_facets {
  449. my $self = shift;
  450. my ($facet_id) = @_;
  451. my %facets = ();
  452. foreach my $edge_id (@{$self->facets_edges->[$facet_id]}) {
  453. $facets{$_} = 1 for @{$self->edges_facets->[$edge_id]};
  454. }
  455. delete $facets{$facet_id};
  456. return keys %facets;
  457. }
  458. sub split_mesh {
  459. my $self = shift;
  460. my @meshes = ();
  461. # loop while we have remaining facets
  462. while (1) {
  463. # get the first facet
  464. my @facet_queue = ();
  465. my @facets = ();
  466. for (my $i = 0; $i <= $#{$self->facets}; $i++) {
  467. if (defined $self->facets->[$i]) {
  468. push @facet_queue, $i;
  469. last;
  470. }
  471. }
  472. last if !@facet_queue;
  473. while (defined (my $facet_id = shift @facet_queue)) {
  474. next unless defined $self->facets->[$facet_id];
  475. push @facets, map [ @$_ ], $self->facets->[$facet_id];
  476. push @facet_queue, $self->get_connected_facets($facet_id);
  477. $self->facets->[$facet_id] = undef;
  478. }
  479. my %vertices = map { $_ => 1 } map @$_[-3..-1], @facets;
  480. my @new_vertices = keys %vertices;
  481. my %new_vertices = map { $new_vertices[$_] => $_ } 0..$#new_vertices;
  482. foreach my $facet (@facets) {
  483. $facet->[$_] = $new_vertices{$facet->[$_]} for -3..-1;
  484. }
  485. push @meshes, Slic3r::TriangleMesh->new(
  486. facets => \@facets,
  487. vertices => [ map $self->vertices->[$_], keys %vertices ],
  488. );
  489. }
  490. return @meshes;
  491. }
  492. 1;