165 lines
3.2 KiB
Perl
165 lines
3.2 KiB
Perl
|
#!/usr/bin/perl -w
|
||
|
|
|
||
|
|
# MergeDrl.pl
|
||
|
|
#
|
||
|
|
# CC-BY 2012 9DOF <9dof.gg@gmail.com>
|
||
|
|
#
|
||
|
|
# Merges several Excellon format drill files into a single file.
|
||
|
|
#
|
||
|
|
# Usage: MergeDrl.pl input_file [...] > output_file
|
||
|
|
#
|
||
|
|
# Output's header will be copied from first input file
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
use IO::File;
|
||
|
|
|
||
|
|
use Data::Dumper;
|
||
|
|
|
||
|
|
sub parseExcellon($);
|
||
|
|
|
||
|
|
# Get arguments
|
||
|
|
my @drills;
|
||
|
|
|
||
|
|
# Parse args and dump content
|
||
|
|
foreach my $fn (@ARGV) {
|
||
|
|
push @drills, parseExcellon($fn);
|
||
|
|
# my $f = new IO::File($fn, 'r');
|
||
|
|
# print 'Dumping ', $fn, "\n";
|
||
|
|
# dumpExcellon($f);
|
||
|
|
}
|
||
|
|
|
||
|
|
#print Dumper(\@drills);
|
||
|
|
|
||
|
|
# Combine drills
|
||
|
|
my %mergedDrills = (
|
||
|
|
tools => {},
|
||
|
|
coords => {});
|
||
|
|
|
||
|
|
my @comboTools = ();
|
||
|
|
foreach my $t(@drills) {
|
||
|
|
while (my($k,$v)=each %{$t->{tools}}){
|
||
|
|
push @comboTools, {spec => $v, coords => $t->{coords}->{$k}};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#print "Combo:\n";
|
||
|
|
#print Dumper(\@comboTools);
|
||
|
|
|
||
|
|
# Sort spec and allocate new indices
|
||
|
|
my $currTool;
|
||
|
|
my $prevTool;
|
||
|
|
my $currIndex = 1;
|
||
|
|
my @finalTools = ();
|
||
|
|
|
||
|
|
foreach my $e(sort {$a->{spec} cmp $b->{spec}} @comboTools) {
|
||
|
|
# Check if same spec as last one
|
||
|
|
if ($prevTool && $prevTool->{spec} eq $e->{spec}) {
|
||
|
|
push @{$prevTool->{coords}}, @{$e->{coords}};
|
||
|
|
} else {
|
||
|
|
$e->{tool} = 'T'.$currIndex++;
|
||
|
|
$prevTool = $e;
|
||
|
|
push @finalTools, $prevTool;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# print Dumper(\@finalTools);
|
||
|
|
|
||
|
|
# Output result
|
||
|
|
local $/ = "\r\n";
|
||
|
|
# Header
|
||
|
|
print "M48$/";
|
||
|
|
foreach my $h(@{$drills[0]->{headers}}) {
|
||
|
|
print "$h$/";
|
||
|
|
}
|
||
|
|
# List of tools
|
||
|
|
foreach my $t(@finalTools) {
|
||
|
|
print $t->{tool}.$t->{spec}.$/;
|
||
|
|
}
|
||
|
|
# End of header
|
||
|
|
print "\%$/";
|
||
|
|
# Body
|
||
|
|
print "G90$/";
|
||
|
|
print "G05$/";
|
||
|
|
print "M72$/";
|
||
|
|
# Coords
|
||
|
|
foreach my $t(@finalTools) {
|
||
|
|
print $t->{tool}, $/;
|
||
|
|
foreach my $c(@{$t->{coords}}) {
|
||
|
|
print "$c$/";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# End
|
||
|
|
print "T0$/";
|
||
|
|
print "M30$/";
|
||
|
|
|
||
|
|
exit 0;
|
||
|
|
|
||
|
|
# Excellon parser
|
||
|
|
sub parseExcellon($) {
|
||
|
|
my ($fn) = @_;
|
||
|
|
my %res = (
|
||
|
|
filename => $fn,
|
||
|
|
tools => {},
|
||
|
|
coords => {},
|
||
|
|
headers => []);
|
||
|
|
|
||
|
|
my $f = new IO::File($fn, 'r');
|
||
|
|
|
||
|
|
my $inHeader = 0;
|
||
|
|
my $inBody = 0;
|
||
|
|
my $currTool;
|
||
|
|
# print "Inside parseExcellon(${fn})\n";
|
||
|
|
while(<$f>){
|
||
|
|
local $/ = "\r\n";
|
||
|
|
chomp;
|
||
|
|
# chop; # input is MSDOS line terminated
|
||
|
|
if (!$inHeader && !$inBody) { # Search for start of header (^M48)
|
||
|
|
if (/^M48/) {
|
||
|
|
# Found start of header
|
||
|
|
$inHeader = 1;
|
||
|
|
} else {
|
||
|
|
# print 's';
|
||
|
|
}
|
||
|
|
} elsif ($inHeader) { # Inside header, collect info until end of header (^%)
|
||
|
|
if (!/^\%/) {
|
||
|
|
# print 'h';
|
||
|
|
if (/^(T\d+)(.*)/) {
|
||
|
|
$res{tools}->{$1} = $2;
|
||
|
|
$res{coords}->{$1} = [];
|
||
|
|
} else {
|
||
|
|
push @{$res{headers}}, $_;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$inHeader = 0;
|
||
|
|
$inBody = 1;
|
||
|
|
}
|
||
|
|
} elsif ($inBody) { # Inside body, collect coords until end of body (^M30)
|
||
|
|
if (!/^M30/) {
|
||
|
|
# print 'b';
|
||
|
|
if (/^(T\d+)/) {
|
||
|
|
$currTool = $1;
|
||
|
|
} elsif ($currTool && exists $res{coords}->{$currTool}) {
|
||
|
|
push @{$res{coords}->{$currTool}}, $_;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$inBody = 0;
|
||
|
|
# print "\n";
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$f->close;
|
||
|
|
# Dump info
|
||
|
|
# print "Info dump\n";
|
||
|
|
# print "Headers:\n";
|
||
|
|
# print @headers;
|
||
|
|
# print "Tools:\n";
|
||
|
|
# print join(",", @tools), "\n";
|
||
|
|
# print "Coords:\n";
|
||
|
|
# foreach my $t(@tools) {
|
||
|
|
# print "Tool: ", $t, "\n";
|
||
|
|
# print @{$coords{$t}};
|
||
|
|
\%res;
|
||
|
|
}
|
||
|
|
|