錐面孔倒角(四)

文章日期：2009-02-22 09:54

現在進入最階段：使用AutoLISP來寫錐面直孔倒角的CNC程式，此程式必需三軸同動才能銑出倒角，由於CNC程式是控制倒角刀底部的中心，前文已求出這些倒角各點座標，故此文不再贅述，直接列出AutoLISP如下，此AutoLISP有呼叫到一個子程式pp1，那是用來寫出算出來的座標點，AutoLISP執行完畢之後，寫出來的CNC程式是放在C:\，檔名為test.nc。

(defun c:bt()
  (command "color" "bylayer" "")
  (setq   r1 5.0  r2 15.0  h1 5.0  r3 4.0  r0 1.0  h0 3.0  c0 0.5)
  (setq r1 (/ (getreal "\nEnter the top diameter : ") 2 ))
  (setq r2 (/ (getreal "\nEnter the bottom diameter : ") 2 ))
  (setq h1 (getreal "\nEnter the height : "))
  (setq r3 (/ (getreal "\nEnter the diameter of the hole : ") 2 ))
  (setq r0 (/ (getreal "\nEnter the bottom diameter of the chamfer tool : ") 2 ))
  (setq h0 (abs (getreal "\nEnter the chamfering height of the chamfer tool : ")) )
  (setq c0 (getreal "\nEnter the chamfering size : ") )
(setq file01 (open "C://test.nc" "w"))
  (princ "%\n" file01)
  (princ "O0001\n" file01)
  (princ "G0 G17 G40 G49G80G90 F200\n" file01)
  (princ "S1500 M03\n" file01)
  (princ "G54 X0 Y0 \n" file01)
  (princ "Z10. H01 \n" file01)
  (setq  cta (/ 3.1415926 180.0)  ctaWk 0  h1 (* -1 (abs h1)) )
  (setq  delR (- r2 r1) xt 0  yt 0  zt 0  x2 0   y2 0 ppr 0)
  (setq  c1 (/ (+ r1 r2) 2)   s1 (/ (* r1 h1) delR) )
  (setq tanValue (/ h1 delR ))
  (setq  i1 0  ctaWk 0  )
  (command "color" "red" "")
  (while (< i1 361)
    (setq ctaWk (* cta i1))
    (setq xt (+ c1 (* (+ r3 c0) (cos ctaWk)))    yt (+ 0 (* (+ r3 c0) (sin ctaWk))) )
    (setq zt (- (* (sqrt (+ (* xt xt) (* yt yt))) tanValue) s1))
    (setq x2 (+ c1 (* (- (+ r3 c0) r0 h0) (cos ctaWk)))  y2 (+ 0 (* (- (+ r3 c0) r0 h0) (sin ctaWk))) )
    (if (= i1 0 )
      (progn
         (setq z2 5 ctype 0)
         (princ "G0 " file01)
         (pp1)
         (setq z2 (- zt h0 -2))
         (princ "   " file01)
         (pp1) ))
    (setq z2 (- zt h0) ctype 1)
    (princ "G1 " file01)
    (pp1)
    (setq i1 (+ 1 i1))
  )
  (princ "Z50. \n" file01)
  (princ "M30 \n" file01)
  (close file01)
  (princ "\nPlease Open the file test.nc at c:\ ." )
  (princ "" )
)

(defun pp1()
  (setq pxs(rtos x2 2 3) pys(rtos y2 2 3) pzs(rtos z2 2 3))
  (setq pxl(strlen pxs) pyl(strlen pys) pzl(strlen pzs))
  (setq pxn(- 7 pxl) pyn(- 7 pyl) pzn(- 7 pzl))
  (princ " X" file01)   (princ pxs file01)
  (if ( or (< (abs (- (fix x2) x2)) 0.001) (< (- 1 (abs (- (fix x2) x2))) 0.001) ) (princ "." file01) )
  (repeat pxn (princ " " file01))
  (princ " " file01)  (princ "Y" file01)  (princ pys file01)
  (if ( or (< (abs (- (fix y2) y2)) 0.001) (< (- 1 (abs (- (fix y2) y2))) 0.001) ) (princ "." file01) )
  (repeat pyn (princ " " file01))
  (princ " " file01)  (princ "Z" file01)  (princ pzs file01)
  (if ( or (< (abs (- (fix z2) z2)) 0.001) (< (- 1 (abs (- (fix z2) z2))) 0.001) ) (princ "." file01) )
  (if (> ctype 1 )
       (progn
          (float ppr)
          (princ " " file01)  (princ "R" file01)  (princ ppr file01)  ))
  (princ "\n" file01)
)
如果各位讀者能融會這幾篇AutoLISP文章，則假以時日，您一定可以使用AutoLISP來解決您在工作上所面臨的問題，AutoLISP寫出的是CNC程式，檔案會比較大，或者，也可以用Marco來寫，Marco程式請參照CNC聚落裡麥剎大大的post文。