woehr gmbh gehauese milling

casings.lisp

@@ -72,4 +72,45 @@
 
 
 ;; X, Y coordnates test brett
-;; 42.9, 20.6 -> 2, 2
+;; 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))))
+

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
 		    )