Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 37fc484637
Fetching contributors…

Cannot retrieve contributors at this time

265 lines (233 sloc) 5.905 kb
(in-package :gcode)
(defun test ()
(g-program
(:m3)
(with-tool (*test-tool*)
(goto-abs :x 10 :y 10)
#+nil(rectangle-mill 10 10 :depth 10)
(rectangle-outline 10 10)
(goto-abs :x 15 :y 10)
(circle-mill 5))
#+nil
(rectangle-outline 10 10 :depth 10)
#+nil
(with-tool-down ()
(goto-rel :x -0.5 :y -0.5)
(rectangle 10 10))
(home)
))
(defun test-transform ()
(g-program
(:m3)
(with-tool (*test-tool*)
(with-transform ((translation-matrix 10 10))
(with-transform ((scaling-matrix 2))
(goto-abs-transform :x 0 :y 0)
(with-tool-down (8)
(mill-abs-transform :x 0 :y 10)
(mill-abs-transform :x 10 :y 10)
(mill-abs-transform :x 10 :y 0)
(mill-abs-transform :x 0 :y 0)))))))
(defun test-round-edge2 ()
(g-program
(spindle-on)
(with-tool (*test-tool*)
(mill-rounded-edge 10 10 20 10 5 3 10 :overlap 4)
#+nil(mill-rounded-edge 20 10 20 20 5 3))))
(defun test-rectangle ()
(with-program ("rectangle")
(spindle-on)
(with-tool (*test-tool*)
(goto-abs :x 10 :y 10)
(with-tool-down ()
(rectangle 10 10)))))
(defun test-rectangle-transform ()
(with-program ("rectangle")
(spindle-on)
(with-tool (*test-tool*)
(with-transform ((translation-matrix 20 20))
(with-transform ((scaling-matrix 10))
(goto-abs :x 10 :y 10)
(with-tool-down ()
(rectangle 10 10)))))))
(defun test-circle ()
(with-program ("circle")
(spindle-on)
(with-tool (*test-tool*)
(with-tool-down ()
(goto-abs :x 50 :y 50)
(circle 40)))))
(defun test-circle-fill ()
(with-program ("circle-fill")
(spindle-on)
(with-tool (*test-tool*)
(with-tool-down ()
(goto-abs :x 50 :y 50)
(circle-fill 40 4)))))
(defun test-move-1 ()
(with-program ("move-test")
(spindle-on)
(with-tool (*test-tool*)
(with-tool-down ()
(dotimes (i 3)
(mill-r)
(mill-bridge-r++))))))
(defun test-move-2 ()
(with-program ("move-test")
(with-tool (*test-tool*)
(tool-up)
(home)
(tool-down :depth *fly-height*)
(with-tool-down ()
(dotimes (i 3)
(mill-bridge-r++)
(mill-u)
(mill-r--)
(mill-d)
(mill-r))))))
(defun test-round-1 ()
(with-program ("round-test")
(with-tool (*test-tool*)
(tool-up)
(home)
(tool-down :depth *fly-height*)
(with-tool-down ()
(dotimes (i 3)
(mill-bridge-r++)
(s-mill-round-u)
(mill-r--)
(s-mill-round-d)
(mill-r))))))
(defun test-file ()
(with-program ("file-tool")
(with-tool (*cube-tool*)
(tool-up)
(home)
(load-file "/Users/manuel/mill.plt"))))
(defun test-moves ()
(g-program
(spindle-on)
(let ((*cut-steps* nil)
(*round-steps* nil))
(with-tool (*test-tool*)
(goto-abs :x 10 :y 10)
(with-tool-down ()
(mill-r++)
(s-mill-round-u)
(mill-r--)
(s-mill-round-d)
(mill-r++)
(s-mill-round-u)
(mill-r--)
(s-mill-round-d)
(mill-r++)
(s-mill-round-u)
(mill-r--)
(s-mill-round-d))
(nreverse *cut-steps*)
(nreverse *round-steps*)))))
(defun test-face-top ()
(g-program
(spindle-on)
(with-tool (*test-tool*)
(with-transform ((translation-matrix 20 20))
(goto-abs-transform :x 18.5 :y 8.5)
(with-tool-down (5)
(mill-abs-transform :x 31.5 :y 8.5)
(mill-abs-transform :x 31.5 :y 18.5))
(mill-rounded-edge 31.5 18.5 41.5 18.5 5 3 3 :overlap 4)
(with-tool-down (5)
(mill-abs-transform :x 41.5 :y 31.5))
(mill-rounded-edge 41.5 31.5 31.5 31.5 5 3 3 :overlap 4)
(with-tool-down (5)
(mill-abs-transform :x 31.5 :y 41.5)
(mill-abs-transform :x 18.5 :y 41.5)
(mill-abs-transform :x 18.5 :y 31.5))
(mill-rounded-edge 18.5 31.5 8.5 31.5 5 3 3 :overlap 4)
(with-tool-down (5)
(mill-abs-transform :x 8.5 :y 18.5))
(mill-rounded-edge 8.5 18.5 18.5 18.5 5 3 3 :overlap 4)
(with-tool-down (5)
(mill-abs-transform :x 18.5 :y 8.5))))))
(defun test-face-top-rel ()
(g-program
(spindle-on)
(let ((*current-x* 10)
(*current-y* 5))
(with-tool (*test-tool*)
(goto-abs :x *current-x* :y *current-y* :z 2)
(with-tool-down (4)
(mill-r++)
(mill-u))
(mill-round-r)
(with-tool-down (4)
(mill-u++))
(mill-round-l)
(with-tool-down (4)
(mill-u)
(mill-l++)
(mill-d))
(mill-round-l)
(with-tool-down (4)
(mill-d++))
(mill-round-r)
(with-tool-down (4)
(mill-d))))))
(defun test-face-bottom-rel ()
(g-program
(spindle-on)
(let ((*current-x* 30)
(*current-y* 5))
(with-tool (*test-tool*)
(goto-abs :x *current-x* :y *current-y* :z 2)
(with-tool-down (4)
(mill-r)
(mill-r++)
(mill-u))
(mill-round-r)
(with-tool-down (4)
(mill-u++))
(mill-round-l)
(with-tool-down (4)
(mill-u)
(mill-l)
(mill-l++)
(mill-d++)
(mill-r)
(mill-d--)
(mill-l)
(mill-d++))))))
(defun cut-test ()
(g-program
(spindle-on)
(let ((*current-x* 50)
(*current-y* 5)
(*round-steps* nil)
(*cut-steps* nil))
(with-tool (*test-tool*)
(goto-abs :x *current-x* :y *current-y* :z 2)
(with-tool-down (*step-width*)
(mill-bridge-r++)
(mill-bridge-r++)
(mill-bridge-u++)
(mill-bridge-u++)
(mill-bridge-l++)
(mill-bridge-l++)
(mill-bridge-d++)
(mill-bridge-d++)
(mill-abs :z 0.5)
(nreverse *cut-steps*))))))
(defun test-round-edge ()
(g-program
(:m3)
(with-tool (*test-tool*)
(goto-abs :x 10 :y 8.5)
(with-tool-down (8)
(mill-abs :x 20 :y 8.5))
(loop for j from 20 downto 10 by 1
collect (mill-abs :z 1)
collect (goto-abs :x j :y 10)
collect (mill-abs :z 0 :y 10)
collect (loop for i from 0 to 90 by 4
collect (mill-abs :y (- 10 (* 1.5 (sin (deg-to-radians i))))
:z (- (* 1.5 (cos (deg-to-radians i))) 1.5)))))))
Jump to Line
Something went wrong with that request. Please try again.