Perl script to help with 3d printer print bed leveling/calibration

level-tool.pl

#!/usr/bin/perl

# 3D printer bed calibration/leveling helper script
#  Version 0.1.2
#  most recent gist @ https://gist.github.com/archi/b3c14ac049ee8df85e744456fe711ac0
#
#  Copyright 2018 by Sebastian Meyer <https://github.com/archi/>
#
#  This program is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation, either version 3 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

use strict;
use warnings;
use Device::SerialPort qw(:PARAM :STAT 0.07);
my $version = "0.1.2";

#
# to do/version log at end of file
# 
# IMPORTANT: Adjust the configuration below here!
#
# Pre-configured values are for my Kossel-style 3d printer
#
# If you set bad values, bad stuff might happen - this script doesn't
#  know anything about your printer and does query your firmware!
#

# a number of coordinates to calibrate at
my @X_pos = (-37, -62, 100, 0);
my @Y_pos = ( 95, -80, -20, 0);

# how fast should the printer move?
# (not applied to G30!)
my $F = 5500;

# how high should the printer head move so you can adjust the screws?
my $z_adjust = 130;

# temperatures, will be passed via M140/M104 (probably in degrees celsius)
# set to undef to disable heating
my $t_bed = 60;
my $t_ext = 190;
#$t_bed = undef;

# baud rate; if more serial parameters differ, adapt the corresponding $serial->stuff(some_value) function
my $baud = 115200;

#
# End of configuration
# 

die "Need a proper F" unless defined $F and $F > 0;

my $serial_name = shift;
die "Need a serial port as parameter!\n" if not defined $serial_name;

print "join", "\n", "3D printer bed calibration/leveling helper script v$version",
"(c) 2018 Sebastian Meyer; licensed under GPL-3-or-later\n\n";


print join "\n * ", "", "", 
    "ATTENTION:",
    "This script will do z-probe right after initialization!!!",
    "Make sure the z-probe is properly set up!!",
    "",
    "Also make sure you properly set the script variables!",
    "",
    "So what will happen after you press enter?",
    "1. the script will connect to the printer at $serial_name",
    "2. the script will power up the print bed ($t_bed degC) and extruder heaters ($t_ext degC)",
    "3. the script will disable print bed leveling (G29 D1)",
    "4. the script will PROBE THE 1st POINT -- OR CRASH YOUR HEAD INTO THE BED TRYING TO DO THAT!!",
    "\n\n";

print "Press <Enter> or <Return> to continue; <Ctrl>+<C> to cancel...";
<STDIN>;

# these settings are good for my marlin...
my $serial = new Device::SerialPort ($serial_name, 1) or die "Could not open '$serial_name': $!\n";
$serial->baudrate($baud);
$serial->parity("none");
$serial->databits(8);
$serial->stopbits(1);

$serial->write_settings || die "Could not write settings: $!\n";

sub passSerialData {
    glob $serial;
    my $timeout = shift;
    my $ptrn = shift;
    $timeout = 1 unless defined $timeout;
    $timeout++ if $timeout >= 0;

    while($timeout > 0 || $timeout == -1) {
        (my $c, my $str) = $serial->read(255);
        if ($c > 0) {
            print $str;
            last if defined $ptrn and $str =~ m/$ptrn/;
        } else {
            $timeout--;
            if ($timeout > 0) {
                print ".";
                sleep 1;
            }
        }
    }
}

sub sendCmd {
    glob $serial;
    my $cmd = shift;
    die "Need a command to send to serial!\n" unless defined $cmd;
    passSerialData (0); 
    $serial->are_match("ok");
    $serial->lookclear;
    $serial->write($cmd . "\r");
    passSerialData (30, "ok"); 
}

passSerialData(4);

sendCmd ("M111 S7");                            # debug on
sendCmd ("M84 S0");                             # disable timeout
sendCmd ("G29 D1");                             # disable bed leveling
sendCmd ("M104 S${t_ext}") if defined $t_ext;   # heat hotend
sendCmd ("M140 S${t_bed}") if defined $t_bed;   # heat bed
sendCmd ("G28");                                # home once
sendCmd ("G0 F$F Z$z_adjust");                  # move to adjustment position
# careful: the script will **PROBE** before getting commands (that's in the logic below)

my $i = -1;
my $homeCounter = -1;

sub home {
    glob $homeCounter;
    $homeCounter--;
    if ($homeCounter < 0) {
        sendCmd("G28");
        $homeCounter = 7;
    }
}

while (1) {
    $i++;
    $i = 0 if ($i >= scalar @X_pos);
    my $x = $X_pos[$i];
    my $y = $Y_pos[$i];
    my $need_move = 1;
    while (1) {
        if ($need_move) {
            die "BAD x: $x" if not defined $x;
            die "BAD y: $y" if not defined $y;
            sendCmd("G30 X$x Y$y");
            sendCmd("G0 Z$z_adjust");
            home ();
        }
        $need_move = 0;

        print " Auto-home in $homeCounter probes.\n" if $homeCounter > 1;
        print " Will auto-home after next probe!\n" if $homeCounter == 1;
        print " Will auto-home prior to next probe!\n" if $homeCounter < 1;
        print join "\n",
            " Commands: ",
            "  [h]          Home now,then probe",
            "  [<Enter>]    Probe again", 
            "  [n]          Probe next coordinate",
            "  [s]          Send something to the printer",
            "  [q]          Quit",
            "> ";
        my $c = <STDIN>;
        $c =~ s/\s*//g;

        last if ($c eq "n");
        if ($c eq "") {
            $need_move = 1; 
            next;
        } elsif ($c eq "h") {
            $need_move = 1;
            $homeCounter = -1;
            home();
            next;
        } elsif ($c eq "s") {
            print "\nPlease enter a gcode (or empty line to cancel):\n> ";
            $c = <STDIN>;
            $c =~ s/\s*$//g; #remove trailing spaces
            if ($c eq "") {
                print "Aborted\n";
                next;
            }
            print "Sending...\n";
            sendCmd($c);
            next;
        } elsif ($c eq "q") {
            $serial->close();
            print "Goodbye and thanks for using this tool! :)\n ** and don't remember to turn off the heaters!! **\n";
            exit 0;
        }

        print "Did not understand...\n";
    }
}

#
# todo:
#  - [a]ll command
#  - probe [p]revious command
#
# log:
# v0.1.2 18.04.2018 - added missing ','; sorry ;)
# v0.1.1 18.04.2018 - added gist url
# v0.1 18.04.2018 - initial release
# 

Here is some example output for Marilin-based firmware.
The result of the probe is the Bed X: [...] Y: [...] Z: <this value here>.

 Auto-home in 4 probes.
 Commands: 
  [h]          Home now
  [<Enter>]    Probe again
  [n]          Go to next coordinate
  [s]          Send something to the printer
  [q]          Quit
> n
.echo:G30 X100 Y-20
.......................Bed X: 100.00 Y: -20.00 Z: 0.06
X:100.00 Y:-20.00 Z:17.33 E:0.00 Count X:54023 Y:89547 Z:68183
ok
.echo:G0 Z130
ok
 Auto-home in 3 probes.
 Commands: 
  [h]          Home now
  [<Enter>]    Probe again
  [n]          Go to next coordinate
  [s]          Send something to the printer
  [q]          Quit
> 
.echo:G30 X100 Y-20
....................Bed X: 100.00 Y: -20.00 Z: 0.01
X:100.00 Y:-20.00 Z:17.28 E:0.00 Count X:54009 Y:89533 Z:68169
ok
.echo:G0 Z130
ok
 Auto-home in 2 probes.
 Commands: 
  [h]          Home now
  [<Enter>]    Probe again
  [n]          Go to next coordinate
  [s]          Send something to the printer
  [q]          Quit
>