yth0407 发表于 2008-1-15 17:30:00

<p>G80是固定指令</p><p>G43 固定指令 H43是刀具</p><p>M06 T16是自动换刀</p><p>感激。。期待程序。。</p><p>ZZXXQQ兄还有颖问请再问。</p>

yth0407 发表于 2008-1-17 22:59:00

ZZXXQQ帮帮忙啊.加我QQ聊也行.我的QQ:343270344

ZZXXQQ 发表于 2008-1-18 21:33:00

本帖最后由 作者 于 2008-1-19 20:23:15 编辑



;生成铣槽NC程序 明经 ZZXXQQ 2008.1.18 修改 2008.1.19
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq dnm (getvar "DWGNAME")
       dnm (substr dnm 1 (- (strlen dnm) 4))
    dnmb (strcat dnm "b.cnc")
       dnm (strcat dnm ".cnc"))
(setq tn (getstring "\nNumber of tools 刀具编号 :"))
(setq td (getdist "\nDiameter of tools 刀具直径 :"))
(setq f (strcat " F" (rtos (getreal "\nFeedRate 进给率 :") 2) "\n"))
; (setq zh (getdist "\nInput Z for start point 输入起点Z坐标 :"))
(setq n 1)
(setq ppl (list (strcat "(" dnm ")\n") '"%\n")
       ppl2 (list (strcat "(" dnmb ")\n") "%\n")
    ppl (cons (strcat "M06 T" tn "(D="(rtos td 2 2)")\n") ppl)
    ppl2 (cons (strcat "M06 T" tn "(D="(rtos td 2 2)")\n") ppl2)
    ppl (cons "M08\n" ppl)
    ppl2 (cons "M08\n" ppl2)
       ppl (cons "G80 G90 G54 F80\n" ppl)
       ppl2 (cons "G80 G90 G54 F80\n" ppl2)
    ppl (cons "G00 X0.0 Y0.0 M03 S1400\n" ppl)
    ppl2 (cons "G00 X0.0 Y0.0 M03 S1400\n" ppl2)
    ppl (cons "G43 H43 Z5.0\n" ppl)
    ppl2 (cons "G43 H43 Z5.0\n" ppl2)
    ppl (cons "G01 F1500 Z5.0\n" ppl)
    ppl2 (cons "G01 F1500 Z5.0\n" ppl2))
(while (and (setq s1 (entsel "\nSelect a slot 选择画好的槽 :"))
          (setq ent (entget(car s1)))
          (or (= (cdr (assoc 0 ent)) "LWPOLYLINE") (= (cdr (assoc 0 ent)) "POLYLINE"))
    (setq pt (getpoint "\nStart Point 起点 :"))
    (setq pc0 (osnap pt "CEN")))
(command ".UNDO" "BE")
(command "explode" (car s1))
(setq ss (ssget "P"))
(setq i -1 ss1 (list) j nil k T ang (angle pt pc0))
(while (= j nil)
   (setq en (ssname ss (setq i (1+ i)))
         ent (entget en))
   (if (= (cdr (assoc 0 ent)) "LINE")
    (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
(setq pc (cdr (assoc 10 ent)) r (cdr (assoc 40 ent))
    k (if (< r (/ td 2)) nil k)
    p1 (polar pc (cdr (assoc 50 ent)) r)
    p2 (polar pc (cdr (assoc 51 ent)) r))
   )
   (if (or (equal (distance pt p1) 0.0 0.0001)
         (equal (distance pt p2) 0.0 0.0001)) (setq j i))
)
(if k (progn
   (repeat (- (sslength ss) j) (setq ss1 (append ss1 (list (ssname ss i))) i (1+ i)))
   (setq i 0)
   (repeat j (setq ss1 (append ss1 (list (ssname ss i))) i (1+ i)))
   (setq i -1 cf T ppl (cons (strcat "N" (itoa n) "\n") ppl))
   (repeat (length ss1)
    (setq ent (entget (nth (setq i (1+ i)) ss1)))
    (if (= (cdr (assoc 0 ent)) "LINE") (progn
   (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
   (if cf (progn
   (if (not (equal (distance pt p1) 0.0 0.0001)) (setq ptm p1 p1 p2 p2 ptm))
   (setq pt0 (polar pt ang (/ td 2))
         cf nil
         ppl (cons (strcat "G00 X" (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) "\n" ) ppl)
      ppl (cons "Z-16.0 F1000\n" ppl)
      pt0 (polar pt0 (angle p1 p2) (distance p1 p2))
         ppl (cons (strcat "G01 X" (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) f) ppl))
)
   (setq pt0 (polar pt0 (angle p1 p2) (distance p1 p2))
         ppl (cons (strcat "G01 X" (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) "\n") ppl))
)
    ) (progn
(setq pc (cdr (assoc 10 ent)) r (cdr (assoc 40 ent))
      p1 (polar pc (cdr (assoc 50 ent)) r)
   p2 (polar pc (cdr (assoc 51 ent)) r))
(if (> r (/ td 2))
   (if cf (progn
    (if (equal (distance pt p1) 0.0 0.0001)
   (setq ccf "G03 X")
   (setq ccf "002 x" ptm p1 p1 p2 p2 ptm)
    )
    (setq pt0 (polar pt ang (/ td 2))
          cf nil
       ppl (cons (strcat "G00 X" (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) "\n") ppl)
    ppl (cons "Z-16.0 F1000\n" ppl)
    pt0 (polar pc ang (- r (/ td 2)))
    ppl (cons (strcat ccf (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) " I"
                     (rtos(car pc) 2 3) " J" (rtos(cadr pc) 2 3) f) ppl))
    (setq pt0 (polar pc ang (- r (/ td 2)))
          ppl (cons (strcat ccf (rtos(car pt0) 2 3) " Y" (rtos(cadr pt0) 2 3) " I"
                     (rtos(car pc) 2 3) " J" (rtos(cadr pc) 2 3) "\n") ppl))
   ))
   (if cf (setq pt0 pc))
)
    ))
   )
   (setq ppl (cons "G00 Z5.0\n" ppl)
         ppl (cons "M01\n" ppl))
)
   (princ "r is too small! Con't cut the slot. 半径太小!")
)
(command ".UNDO" "E")
(command "_U")
(command ".UNDO" "BE")
(command "OFFSET" (- (/ td 2) 0.25) (cadr s1) (polar pt ang (/ td 2)) "")
(command "explode" "l")
(setq ss (ssget "P"))
(setq i -1 ss1 (list) j nil pt0 (polar pt ang (- (/ td 2) 0.25)))
(while (= j nil)
   (setq en (ssname ss (setq i (1+ i)))
         ent (entget en)) (princ i)
   (if (= (cdr (assoc 0 ent)) "LINE")
    (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
(setq pc (cdr (assoc 10 ent)) r (cdr (assoc 40 ent))
    p1 (polar pc (cdr (assoc 50 ent)) r)
    p2 (polar pc (cdr (assoc 51 ent)) r))
   )
   (if (or (equal (distance pt0 p1) 0.0 0.0001)
         (equal (distance pt0 p2) 0.0 0.0001)) (setq j i))
)
(repeat (- (sslength ss) j) (setq ss1 (append ss1 (list (ssname ss i))) i (1+ i)))
(setq i 0)
(repeat j (setq ss1 (append ss1 (list (ssname ss i))) i (1+ i)))
(setq i -1 cf T ppl2 (cons (strcat "N" (itoa n) "\n") ppl2))
(repeat (length ss1)
   (setq ent (entget (nth (setq i (1+ i)) ss1)))
   (if (= (cdr (assoc 0 ent)) "LINE") (progn
    (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
    (if cf (progn
(if (not (equal (distance pt0 p1) 0.0 0.0001)) (setq ptm p1 p1 p2 p2 ptm))
(setq cf nil
      ppl2 (cons (strcat "G00 X" (rtos(car p1) 2 3) " Y" (rtos(cadr p1) 2 3) "\n" ) ppl2)
   ppl2 (cons "Z-16.0 F1000\n" ppl2)
      ppl2 (cons (strcat "G01 X" (rtos(car p2) 2 3) " Y" (rtos(cadr p2) 2 3) f) ppl2)
   pt0 p2)
)
(setq ppl2 (cons (strcat "G01 X" (rtos(car p2) 2 3) " Y" (rtos(cadr p2) 2 3) "\n") ppl2)
      pt0 p2)
)
   ) (progn
(setq pc (cdr (assoc 10 ent)) r (cdr (assoc 40 ent))
       p1 (polar pc (cdr (assoc 50 ent)) r)
    p2 (polar pc (cdr (assoc 51 ent)) r))
(if cf (progn
(if (equal (distance pt0 p1) 0.0 0.0001)
   (setq ccf "G03 X")
   (setq ccf "002 x" ptm p1 p1 p2 p2 ptm)
)
(setq cf nil
   ppl2 (cons (strcat "G00 X" (rtos(car p1) 2 3) " Y" (rtos(cadr p1) 2 3) "\n") ppl2)
   ppl2 (cons "Z-16.0 F1000\n" ppl2)
   pt0 p2
   ppl2 (cons (strcat ccf (rtos(car p2) 2 3) " Y" (rtos(cadr p2) 2 3) " I"
                     (rtos(car pc) 2 3) " J" (rtos(cadr pc) 2 3) f) ppl2))
    )
(setq pt0 p2
      ppl2 (cons (strcat ccf (rtos(car p2) 2 3) " Y" (rtos(cadr p2) 2 3) " I"
                     (rtos(car pc) 2 3) " J" (rtos(cadr pc) 2 3) "\n") ppl2))
)
   ))
)
(setq ppl2 (cons "G00 Z5.0\n" ppl2)
      ppl2 (cons "M01\n" ppl2))
(setq n (1+ n))
)
(command ".UNDO" "E")
(command "_U")
(setq fp (open dnm "w"))
(setq ppl (cons "M30\n" ppl))
(setq ppl2 (cons "M30\n" ppl2))
(setq ppl (reverse ppl) i -1)
(repeat (length ppl)
(princ (nth (setq i (1+ i)) ppl) fp)
)
(close fp)
(setq fp1 (open dnmb "w"))
(setq ppl2 (reverse ppl2) i -1)
(repeat (length ppl2)
(princ (nth (setq i (1+ i)) ppl2) fp1)
)
(close fp1)
(command "notepad" dnm)
(command "notepad" dnmb)
(princ)
)

linheyuanpcb 发表于 2008-1-19 08:29:00

%%%我蚱就看不了呢/?原来是贴子太少了,我去DING人家的贴才行了,呵——

yth0407 发表于 2008-1-19 10:51:00

<p>ZZXXQQ兄,怎么执行了TT不见程式呢?程式要存到指定的文件夹里面好吗?比如C:\1\*.CNC *B.CNC</p><p>有错误,请ZZXXQQ兄再改改好吗?</p><p>Command: tt<br/>Number of tools 刀具编号 :1<br/>Diameter of tools 刀具直径 :8<br/>FeedRate 进给率 :100<br/>Select a slot 选择画好的槽 :<br/>Start Point 起点 :cen of Unknown command "UNOD".&nbsp; Press F1 for help.<br/>Unknown command "BE".&nbsp; Press F1 for help.<br/>Unknown command "EXPLODE".&nbsp; Press F1 for help.<br/>&lt;Entity name: 7EF54D08&gt;</p><p></p>

linheyuanpcb 发表于 2008-1-19 11:56:00

<p>是锣边机用的程序吗?</p>

ZZXXQQ 发表于 2008-1-19 13:04:00

<p>起点不要选在中心,要选在铣切开始点。</p>

yth0407 发表于 2008-1-19 17:28:00

还是不见程式啊,是怎么回事呢?能不能改成像第1楼说的那样呢?要把转出来程式存成文本文件到指定文件夹,在图形里面也能附上加工说明.谢谢了.

sailorcwx 发表于 2008-1-19 18:16:00

"UNOD"应该为"UNDO"

ZZXXQQ 发表于 2008-1-19 20:25:00

谢楼上指正。13楼已改,再试试。
页: 1 [2] 3 4 5
查看完整版本: 求能转CNC铣槽加工程式的LISP程序