Skip to content

Commit

Permalink
added new lisp stuff and shit
Browse files Browse the repository at this point in the history
  • Loading branch information
wesen3000 committed Mar 21, 2010
1 parent 694f3b2 commit 511b4a8
Show file tree
Hide file tree
Showing 5 changed files with 177 additions and 78 deletions.
57 changes: 54 additions & 3 deletions casings.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
.(in-package :gcode)
(in-package :gcode)

(defun hammond-29830-psla ()
(with-program ("hammond-29830")
Expand Down Expand Up @@ -96,9 +96,9 @@
(with-named-pass ("outline")
(with-tool (*mdf-tool-2mm*)
(goto-abs :x 0 :y 0)
(rectangle-inline 93.5 119 :depth 1)
(rectangle-inline 93.5 119 :depth 2)
(goto-abs :x 0.7 :y 0.7)
(rectangle-inline (- 93.5 1.4) (- 119 1.4) :depth 1)))
(rectangle-inline (- 93.5 1.4) (- 119 1.4) :depth 2)))

(with-named-pass ("drills")
(with-tool (*mdf-tool-2mm*)
Expand Down Expand Up @@ -131,6 +131,24 @@

)))))

(defun woehr-gehauese-090-rueckwaerts-drills2 ()
(with-tool (*mdf-tool-2mm*)
(spindle-on)
(goto-abs :x 0 :y 0)
(goto-abs :z *fly-height*)

(with-named-pass ("drills")
(with-tool (*mdf-tool-2mm*)
(goto-abs :x 0 :y 0)
(goto-abs :z *fly-height*)

(drill :y 5 :x 4.65 :diameter 7 :depth 11)
(drill :y 5 :x (- 93.5 4.65) :diameter 7 :depth 11)
(drill :y (- 119 5) :x (- 93.5 4.65) :diameter 7 :depth 11)
(drill :y (- 119 5) :x 4.65 :diameter 7 :depth 11)

))))


(defun woehr-090-program ()
(with-program ("woehr")
Expand Down Expand Up @@ -204,5 +222,38 @@
(with-transform ((translation-matrix 0 244))
(woehr-gehauese-090-rueckwaerts-drills)))))))

(defun woehr-090-platte-rueckwaerts2 ()
(with-program ("woehr")
(with-named-pass ("mill")
(with-tool (*mdf-tool-2mm*)
(with-transform ((translation-matrix -7 0))
(woehr-gehauese-090-rueckwaerts-drills2)
(with-transform ((translation-matrix 0 122))
(woehr-gehauese-090-rueckwaerts-drills2))
(with-transform ((translation-matrix 0 244))
(woehr-gehauese-090-rueckwaerts-drills2))

(with-transform ((translation-matrix 105 0))
(woehr-gehauese-090-rueckwaerts-drills2)
(with-transform ((translation-matrix 0 122))
(woehr-gehauese-090-rueckwaerts-drills2))
(with-transform ((translation-matrix 0 244))
(woehr-gehauese-090-rueckwaerts-drills2)))

(with-transform ((translation-matrix 210 0))
(woehr-gehauese-090-rueckwaerts-drills2)
(with-transform ((translation-matrix 0 122))
(woehr-gehauese-090-rueckwaerts-drills2))
(with-transform ((translation-matrix 0 244))
(woehr-gehauese-090-rueckwaerts-drills2)))

(with-transform ((translation-matrix 315 0))
(woehr-gehauese-090-rueckwaerts-drills2)
(with-transform ((translation-matrix 0 122))
(woehr-gehauese-090-rueckwaerts-drills2))
(with-transform ((translation-matrix 0 244))
(woehr-gehauese-090-rueckwaerts-drills2))))))))




16 changes: 11 additions & 5 deletions gcode.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,11 @@
:version "0.1"
:maintainer "Manuel Odendahl <[email protected]>"
:serial t
:depends-on (:cl-gd :uffi :cocoahelper :lispbuilder-sdl :unit-test :cl-pdf :cxml :cl-ppcre)
:depends-on (#+nil :cl-gd
:uffi
#+nil :cocoahelper
#+nil :lispbuilder-sdl
:unit-test :cl-pdf :cxml :cl-ppcre)
:components
(
;; thirdparty
Expand All @@ -25,7 +29,7 @@
(:file "geometry")
(:file "arc")
(:file "bezier")
(:file "offset")
;; (:file "offset")

;; potrace externals
(:file "pot-uffi")
Expand All @@ -35,15 +39,15 @@
(:file "opcodes")

;; tracer
(:file "potrace")
;; (:file "potrace")

;; panelizing and stuff
(:file "shapes")
(:file "moves")
(:file "panel")
(:file "cube")

(:file "raster")
;; (:file "raster")

;; optimizer
(:file "optimize")
Expand All @@ -52,9 +56,11 @@
(:file "drill")

;; formats and exporters and importers
(:file "sdl")
#+nil(:file "sdl")
(:file "p5")
(:file "pdf")
(:file "svg")

(:file "minicommand")

))
152 changes: 83 additions & 69 deletions minicommand.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,77 +34,82 @@
(defun frontplate-element (&key name package x y angle)
(with-named-pass ("frontplate")
(cond ((or (string= package "3FTL06")
(string= package "3FTL06-LED")
(string= package "JOYSTICK"))
(when *frontplate-top*
(drill :x x :y y :diameter 2 :depth 0.5)))
((string= package "DISPLAY-TEXT-C1624A")
(when *frontplate-top*
;; (with-named-pass ("display")
(with-tool (*alu-tool*)
(progn (goto-abs :x (- x 32.6) :y (- y 16.9))
(rectangle-inline 71.5 26.5 :depth *frontplate-depth*)))))
#+nil((string= package "CI-11")
(when *frontplate-top*
(drill :x x :y y :diameter 2 :depth 0.5))))))
(string= package "3FTL06-LED")
(string= package "JOYSTICK"))
(when *frontplate-top*
(drill :x x :y y :diameter 2 :depth 2.5)))
#+nil((string= package "DISPLAY-TEXT-C1624A")
(when *frontplate-top*
;; (with-named-pass ("display")
(with-tool (*alu-tool*)
(progn (goto-abs :x (- x 32.6) :y (- y 16.9))
(rectangle-inline 71.5 26.5 :depth *frontplate-depth*)))))
#+nil((string= package "CI-11")
(when *frontplate-top*
(drill :x x :y y :diameter 2 :depth 0.5))))))


(defun frontplate-element (&key name package x y angle)
(with-named-pass ("frontplate")
(cond ((or (string= package "3FTL06")
(string= package "3FTL06-LED"))
(when *frontplate-top*

;; test
;; (drill :x x :y y :diameter 2 :depth 0.5)

;; real one
(drill :x x :y y :diameter 10.5 :depth *frontplate-depth*)
))
((string= package "JOYSTICK")
(drill :x x :y y :diameter 23 :depth *frontplate-depth*))
((string= package "CI-11")
(when *frontplate-top*
(drill :x x :y y :diameter 7.5 :depth *frontplate-depth*)))
((string= package "LED5MM")
(when *frontplate-top*
(drill :x x :y y :diameter 5.5 :depth *frontplate-depth*)))
((string= package "POWER")
(when *frontplate-top*
;; orig
(progn
(goto-abs :x (- x 7.25) :y (- y 3.75))
(rectangle-inline 14 7.5 :depth *frontplate-depth*)
)))

((string= package "MAB5SH")
(when *frontplate-side*
#-debug
(drill :x 11.5 :y (- x 1.0) :diameter 18.5 :depth *frontplate-depth*)

#+debug
(drill :x 11.5 :y (- x 1.0) :diameter 2 :depth 2)
))

((string= package "DCJ0202")
(when *frontplate-side*
#+nil
(progn ;; orig
(goto-abs :x 0 :y (+ y 5))
(rectangle-inline 12 10 :depth *frontplate-depth*))

#-debug
(progn
(goto-abs :x 1.2 :y (+ y 5))
(rectangle-inline 11 9.5 :depth *frontplate-depth*))))

((string= package "DISPLAY-TEXT-C1624A")
(when *frontplate-top*
;; (with-named-pass ("display")
(with-tool (*alu-tool*)
(progn (goto-abs :x (- x 32.6) :y (- y 16.9))
(rectangle-inline 71.5 26.5 :depth *frontplate-depth*))))))))
(string= package "3FTL06-LED"))
(when *frontplate-top*

(with-named-pass ("test")
(drill :x x :y y :diameter 2 :depth 0.5))

;; real one
(drill :x x :y y :diameter 10.5 :depth *frontplate-depth*)
))

((string= package "JOYSTICK")
(drill :x x :y y :diameter 23 :depth *frontplate-depth*))

((string= package "CI-11")
(when *frontplate-top*
(drill :x x :y y :diameter 7.5 :depth *frontplate-depth*)
(with-named-pass ("test")
(drill :x x :y y :diameter 2 :depth 0.5))))

((string= package "LED5MM")
(when *frontplate-top*
(drill :x x :y y :diameter 5.5 :depth *frontplate-depth*)))
((string= package "POWER")
(when *frontplate-top*
;; orig
(progn
(goto-abs :x (- x 7.25) :y (- y 3.75))
(rectangle-inline 14 7.5 :depth *frontplate-depth*)
)))

((string= package "MAB5SH")
(when *frontplate-side*
#-debug
(drill :x 11.5 :y (- x 1.0) :diameter 18.5 :depth *frontplate-depth*)

#+debug
(drill :x 11.5 :y (- x 1.0) :diameter 2 :depth 2)
))

((string= package "DCJ0202")
(when *frontplate-side*
#+nil
(progn ;; orig
(goto-abs :x 0 :y (+ y 5))
(rectangle-inline 12 10 :depth *frontplate-depth*))

#-debug
(progn
(goto-abs :x 1.2 :y (+ y 5))
(rectangle-inline 11 9.5 :depth *frontplate-depth*))))

((string= package "DISPLAY-TEXT-C1624A")
(when *frontplate-top*
;; (with-named-pass ("display")
(with-tool (*alu-tool*)
(progn (goto-abs :x (- x 32.6) :y (- y 16.9))
(rectangle-inline 71.5 26.5 :depth *frontplate-depth*))))))))

(defun test-file (&key (x 0) (y 0))
(let ((*frontplate-elements* nil))
Expand Down Expand Up @@ -149,6 +154,11 @@
(defparameter *alu-tool*
(make-instance 'tool :diameter 2 :depth 2.6 :number 8 :feed-xy 500 :feed-z 100))

;; FUER FROTPLATTEN
(defparameter *alu-tool*
(make-instance 'tool :diameter 2 :depth 1.3 :number 8 :feed-xy 500 :feed-z 100))


(defun minicommand-casing-side-top-hammond-first ()
(let ((tool *alu-tool*)
(*frontplate-depth* 3.3))
Expand All @@ -170,7 +180,7 @@

(defun minicommand-casing-side-top ()
(let ((tool *alu-tool-top*)
(*frontplate-depth* 3.2))
(*frontplate-depth* 3.4))

(with-program ("casing")
(with-named-pass ("umrandung")
Expand Down Expand Up @@ -580,6 +590,10 @@

))

(defun single-minicommand ()
(with-program ("casing")
(minicommand-frontplate *alu-tool*)))

(defun test-minicommand-casing-weit (&optional (start 0))
(let ((tool *alu-tool*))

Expand Down Expand Up @@ -690,4 +704,4 @@
)

(mill-abs :z 2)))))


28 changes: 28 additions & 0 deletions pcb-fix.lisp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
(in-package :gcode)

(defparameter *epoxy-tool*
(make-instance 'tool
:diameter 0.3
:number 13
:depth 1))

(defun pcb-fix ()
(let ((*fly-height* 8))
(with-program ("pcb-fix")
(goto-abs :z *fly-height*)
(with-tool (*epoxy-tool*)
(with-named-pass ("mill")
(home)
(goto-abs :x 24.9 :y 3)
(with-tool-down (0.8)
(mill-rel :x -9)
(mill-rel :y 11)

(mill-rel :x 6)
(mill-rel :y 8)
(mill-rel :x 14)
(mill-rel :y -14)
(mill-rel :x -11)
(mill-rel :y -5)
))))))

2 changes: 1 addition & 1 deletion shapes.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,7 @@
(warn "Can not drill hole that is ~A big, resorting to ~A~%"
diameter (tool-diameter *current-tool*))
(setf diameter (tool-diameter *current-tool*)))
(format t "depth: ~A~%" depth)
#+nil(format t "depth: ~A~%" depth)
(let ((d (/ (- diameter (tool-diameter *current-tool*)) 2)))
(goto-abs :x x :y (- y d))
(if (= d 0)
Expand Down

0 comments on commit 511b4a8

Please sign in to comment.