diff --git a/casings.lisp b/casings.lisp index 19be99d..f86a2c0 100644 --- a/casings.lisp +++ b/casings.lisp @@ -72,4 +72,45 @@ ;; X, Y coordnates test brett -;; 42.9, 20.6 -> 2, 2 \ No newline at end of file +;; 42.9, 20.6 -> 2, 2 + + +;; mini command woehr +;; http://www.industriegehaeuse.woehrgmbh.de/assets/pdf/GH02AL002-010-030_060-110_150.pdf +;; distance between drills: 109.5, 84.2 +;; outer dimensions: 119.0, 93.5, 34.0 + +(defun woehr-gehauese-090 () + (with-tool ((make-instance 'tool + :diameter 2 + :number 6 + :feed-xy 600 + :feed-z 240 + :depth 3)) + (spindle-on) + (goto-abs :x 0 :y 0) + (goto-abs :z *fly-height*) + + (with-named-pass ("outline") + (goto-abs :x 0 :y 0) + (rectangle-inline 93.5 119 :depth 1) + (goto-abs :x 0.7 :y 0.7) + (rectangle-inline (- 93.5 1.4) (- 119 1.4) :depth 1)) + + (with-named-pass ("drills") + (goto-abs :x 0 :y 0) + (goto-abs :z *fly-height*) + + (drill :y 5 :x 4.65 :diameter 3.5 :depth 8) + (drill :y (- 119 5) :x 4.65 :diameter 3.5 :depth 8) + (drill :y (- 119 5) :x (- 93.5 4.65) :diameter 3.5 :depth 8) + (drill :y 5 :x (- 93.5 4.65) :diameter 3.5 :depth 8)))) + +(defun woehr-090-program () + (with-program ("woehr") + (woehr-gehauese-090) + (with-transform ((translation-matrix 0 122)) + (woehr-gehauese-090)) + (with-transform ((translation-matrix 0 244)) + (woehr-gehauese-090)))) + diff --git a/drill.lisp b/drill.lisp index 637f491..ac17500 100644 --- a/drill.lisp +++ b/drill.lisp @@ -8,6 +8,15 @@ :feed-z 240 :depth 2.2)) +(defparameter *engrave-tool* + (make-instance 'tool + :diameter 1 + :number 9 + :feed-xy 600 + :feed-z 240 + :depth 1)) + + (defun pcb (file outfile) (program-to-file (with-program ("pcb") @@ -29,11 +38,16 @@ (defvar *drills*) +(defvar *eagle-drills-p* t) +(defvar *eagle-vias-p* nil) + (defun add-drill (&key x y diameter) - (push (list x y diameter) *drills*)) + (when *eagle-drills-p* + (push (list x y diameter) *drills*))) (defun add-via (&key x y diameter) - (push (list x y diameter) *drills*)) + (when *eagle-vias-p* + (push (list x y diameter) *drills*))) (defun square (x) @@ -101,24 +115,41 @@ (defvar *frontplate-program*) (defvar *frontplate-elements*) -(defparameter *frontplate-depth* 3.0) +(defparameter *frontplate-depth* 3.6) +(defvar *frontplate-top* t) +(defvar *frontplate-side* nil) (defun frontplate-element (&key name package x y angle) (with-named-pass ("frontplate") (cond ((string= package "3FTL06") - (drill :x x :y y :diameter 10.5 :depth *frontplate-depth*)) + (when *frontplate-top* + (drill :x x :y y :diameter 10.5 :depth *frontplate-depth*))) ((string= package "CI-11") - (drill :x x :y y :diameter 7.5 :depth *frontplate-depth*)) + (when *frontplate-top* + (drill :x x :y y :diameter 7.5 :depth *frontplate-depth*))) ((string= package "LED5MM") - (drill :x x :y y :diameter 5.5 :depth *frontplate-depth*)) + (when *frontplate-top* + (drill :x x :y y :diameter 5.5 :depth *frontplate-depth*))) ((string= package "POWER") + (when *frontplate-top* (progn (goto-abs :x (- x 7.25) :y (- y 4.25)) (rectangle-inline 14.5 8.5 :depth *frontplate-depth*) - )) + ))) + + ((string= package "MAB5SH") + (when *frontplate-side* + (drill :x 11.5 :y x :diameter 18.5 :depth *frontplate-depth*))) + + ((string= package "DCJ0202") + (when *frontplate-side* + (goto-abs :x 0 :y (+ y 5)) + (rectangle-inline 12 10 :depth *frontplate-depth*))) + ((string= package "DISPLAY-TEXT-C1624A") - (progn (goto-abs :x (- x 32.6) :y (- y 16.9)) - (rectangle-inline 72 27 :depth *frontplate-depth*)))))) + (when *frontplate-top* + (progn (goto-abs :x (- x 32.6) :y (- y 16.9)) + (rectangle-inline 72 27 :depth *frontplate-depth*))))))) (defun test-file (&key (x 0) (y 0)) (let ((*frontplate-elements* nil)) @@ -156,8 +187,52 @@ ))) +(defparameter *alu-tool* + (make-instance 'tool :diameter 2 :depth 1.2 :number 8 :feed-xy 500 :feed-z 100)) + +(defun minicommand-casing-side-top-hammond-first () + (let ((tool *alu-tool*)) + (with-program ("casing") + (with-named-pass ("frontplate") + (with-tool (tool) + (goto-abs :x 0 :y 0) + (goto-abs :z *fly-height*))) + + + (with-named-pass ("mill") + (with-tool (*alu-tool*) + (with-transform ((translation-matrix 2.1 8.5)) + (let ((*eagle-drills-p* nil) + (*frontplate-top* nil) + (*frontplate-side* t)) + (load-file "/Users/manuel/siff-svn/ruinwesen/eagle/midicommand/minicommand.lisp")))))))) + + +(defun minicommand-casing-side-top () + (let ((tool *alu-tool*)) + (with-program ("casing") + #+nil(with-named-pass ("umrandung") + (goto-abs :x 0 :y 0) + (rectangle 31 118)) + + (with-named-pass ("frontplate") + (with-tool (tool) + (goto-abs :x 0 :y 0) + (goto-abs :z *fly-height*))) + + + + (with-named-pass ("mill") + (with-tool (*alu-tool*) + (with-transform ((translation-matrix 2.1 5)) ;; 4 pcb zu rand + 1 + (let ((*eagle-drills-p* nil) + (*frontplate-top* nil) + (*frontplate-side* t)) + (load-file "/Users/manuel/siff-svn/ruinwesen/eagle/midicommand/minicommand.lisp")))))))) + (defun test-minicommand-casing () - (let ((tool (make-instance 'tool :diameter 2 :depth 1 :number 8 :feed-xy 500 :feed-z 100))) + (let ((tool *alu-tool*)) + (with-program ("casing") (with-named-pass ("frontplate") @@ -166,12 +241,35 @@ (goto-abs :z *fly-height*))) (with-tool (tool) - (with-transform ((translation-matrix 2.5 -2.5)) + (with-transform ((translation-matrix 2.5 -3)) (with-transform ((translation-matrix 90 0)) (with-transform ((rotation-matrix -90)) (with-transform ((translation-matrix 5 3)) - (load-file "/Users/manuel/siff-svn/ruinwesen/eagle/midicommand/minicommand-ioboard.lisp"))))) - + (load-file "/Users/manuel/siff-svn/ruinwesen/eagle/midicommand/minicommand-ioboard.lisp")))) + + + (with-named-pass ("engrave") + (let* ((curves (mapcar #'curve-to-arcs (interpret-svg (load-svg "/Users/manuel/Downloads/minicommand-engrave.svg")))) + (wbbox (bounding-box curves))) + (format t "wbbox: ~A width: ~A height; ~A~%" wbbox (bbox-width wbbox) (bbox-height wbbox)) + + (with-tool (*engrave-tool*) + (with-transform ((translation-matrix 87.5 2)) + (with-transform ((rotation-matrix -90)) + (with-transform ((translation-matrix 21 1.5)) + (with-transform ((scaling-matrix 0.28)) + (with-transform ((translation-matrix (- (2d-point-x (line-a wbbox))) + (- (2d-point-y (line-a wbbox))))) + (dolist (curve curves) + (goto-abs :z *fly-height*) + (let ((start (curve-start curve))) + (goto-abs :x (2d-point-x start) + :y (2d-point-y start))) + (with-tool-down () + (mill-curve curve) + ))))))))))) + + (with-named-pass ("umrandung") (goto-abs :x 0 :y -2 )