求能转CNC铣槽加工程式的LISP程序
<p></p><p>步骤:执行命令-提示输入文件名<默认为当前文件名>--提示反面铣槽单边比正面大多少<默认0.5>--指定放加工说明文字的点</p><p>功能:先画好要铣槽的形状大小放到指定层,再在槽里面画一个铣刀大小的圆放到指定层为起刀点,如一个图形有很多槽的话也能输入命令就能转出正面反面程式,(程式为TXT文件,正面一个,反面一个)存到指定文件夹.在图形边上也有注明加工说明 (详见附件)</p><p>请高手帮帮忙,小弟先谢谢了.如果小弟说的不是很清楚,请跟贴说出疑问.</p><p>如果你帮了小弟这忙,可提些能让小弟力所能及的要求.比如帮忙充手机话费.Q币之类的....谢谢.</p> 本帖最后由 ZZXXQQ 于 2018-3-8 14:44 编辑先试试。程序未经调试。
;生成铣槽NC程序 明经 ZZXXQQ 2008.2.6
(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 hd T)
(setq n 1)
(setq pl (list)
ppl (list (strcat "(" dnm ")\n") '"%\n")
ppl2 (list (strcat "(" dnmb ")\n") "%\n"))
(while (or (initget 1 "H ")
(setq s1 (entsel "\nSelect a slot 选择画好的槽 (H=换刀) :")))
(if (= s1 "H") (progn
(setq tn (getstring "\nNumber of tools 刀具编号 :"))
(setq td (getdist "\nDiameter of tools 刀具直径 :"))
(setq f (strcat " F" (rtos (getreal "\nFeedRate 进给率 :") 2) "\n"))
(setq hd T
pl (cons (strcat "加工编号" stno "-N" (itoa n))))
)
(if (and (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"))) (progn
(if hd
(setq 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)
hd nil
pl (cons (strcat "刀具大小=" (rtos td 2)) pl)
stno (strcat "N" (itoa n)))
)
(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")
))
)
)
(if (and (listp pl) (listp ppl) (listp ppl2)) (progn
(setq pl (cons (strcat "铣槽正面程式" dmm) pl)
pl (cons (strcat "铣槽反面程式" dnmb) pl)
pl (reverse pl))
(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)
(setq pt (getpoint "\nStart Text(s) Point 文字开始点 :"))
(setq i -1)
(repeat (length pl)
(command ".text" pt 3 0 (nth (setq i (1+ i)) pl))
)
(command "notepad" dnm)
(command "notepad" dnmb)
))
(princ)
)
本帖最后由 ZZXXQQ 于 2023-6-6 12:58 编辑
先给个画槽的程序。
;槽绘制 ZZXXQQ 2008.1.9
<blockquote>(defun C:DRAWSLOT ()
(defun C:DRAWSLOT ()
(setvar "CMDECHO" 0)
(setq OLDOS (GETvar "OSMODE"))
(setvar "OSMODE" 0)
(command ".UNDO" "BE")
(setq W (getdist "\n输入槽宽 W= <4>")
W (if W W 4)
W5 (* W 0.5)
R (getdist "\n输入内圆角半径 R= ")
R1 (getdist
(strcat "\n输入外圆角半径 <" (rtos W5 2 1) ">小于R1小于" (rtos (+ R W) 2 1) " R1= "))
R1 (if (and (< W5 R1) R1) R1 W5)
R1 (if (> R1 (+ R W)) (+ R W) R1)
PT (getpoint "\n槽起点 <0,0>: ")
PT (if PT PT (LIST 0 0))
AL1 (/ PI 2) AL2 (- AL1)
PT1 (getpoint PT "\n槽下一点 :")
A (angle PT PT1) A1 (+ A AL1) A2 (+ A AL2)
DS (distance PT1 PT)
P1 (polar PT A1 W5)
P2 (polar PT A2 W5)
P3 (polar P1 A (- DS R))
P4 (polar P2 A (- DS R))
PT PT1 FIR P3 SEC P4 SS (entlast) SS2 (ssadd))
(command "LINE" P3 P1 "") (setq S1 (entlast))
(command "ARC" "" P2 "LINE" P2 P4 "") (setq S2 (entlast))
(while (setq PT1 (getpoint PT "\n槽下一点 :"))
(setq A0 (angle PT PT1) A1 (+ A0 AL1) A2 (+ A0 AL2)
DS (distance PT1 PT)
P1 (polar (polar PT A1 W5) A0 R)
P2 (polar (polar PT A2 W5) A0 R)
P3 (polar P1 A0 (- DS R R))
P4 (polar P2 A0 (- DS R R)))
(command "LINE" P1 P3 "") (setq S3 (entlast))
(command "LINE" P2 P4 "") (setq S4 (entlast))
(if (> (distance P1 FIR) (distance P2 SEC))
(command "FILLET" "R" R "FILLET" S2 S4 "FILLET" "R" R1 "FILLET" S1 S3)
(command "FILLET" "R" R1 "FILLET" S2 S4 "FILLET" "R" R "FILLET" S1 S3)
)
(setq A A0 PT PT1 S1 S3 S2 S4 FIR P3 SEC P4)
)
(setq P1 (polar P3 A0 R) P2 (polar P4 A0 R))
(command "STRETCH" "C" P3 P3 "" P3 P1 "STRETCH" "C" P4 P4 "" P4 P2)
(command "ARC" P2 "C" PT P1)
(if SS
(while (setq S1 (entnext SS))
(setq SS2 (ssadd S1 SS2) SS S1)
)
(setq SS2 (ssget "X"))
)
(command "PEDIT" "M" SS2 "" "Y" "J" "0.001" "")
(command ".UNDO" "E")
(setvar "OSMODE" OLDOS)
(setvar "CMDECHO" 1)
(princ)
)
(prompt "\nDRAWSLOT 加载成功。")
(princ)
<p>高手帮帮忙,小弟急用,谢谢了.</p> <p>等待中...</p> 先谢谢ZZXXQQ版主,可能是我表达不好导致ZZXXQQ兄理解错误了,我的意思是画槽(要铣槽的形状大小)是手工先画好的,这不需要程序,我要的LSP程序是转铣槽程式的,就是输入命令能转出指定层槽孔的程式.,程式的格式如附件上的正反二个. 问题：<br/>1、图中画的刀具直径与槽宽相同，但加工时却有与槽宽垂直的进刀，这样加工出的槽宽与图中不符。为什么？<br/>2、数控系统是什么型号的？<br/>3、能否给个G代码简要说明？<br/> 不知道是实际使用还是毕业设计之类的？实际使用只要达到目的，方法很多... <p>顶一下,虽然非我领域使用,但有学习价值喔!谢谢楼主!</p><p></p> ZZXXQQ发表于2008-1-12 16:39:00static/image/common/back.gif问题：1、图中画的刀具直径与槽宽相同，但加工时却有与槽宽垂直的进刀，这样加工出的槽宽与图中不符。为什么？2、数控系统是什么型号的？3、能否给个G代码简要说明？
<p>1,图中画的刀具直径是与槽宽相同的,附件程式垂直进刀的,加工出的槽宽正面是与图中相符的,背面是要看你在转程式时输入背面单边比正面大多少而定,附件是单边大0.5的程式.因为我需要加工出的槽背面比正面要大的.</p><p>2,数控系统是日本兄弟机,法兰克系统,据我了解三菱系统与法兰克系统程式基本上是通用的.</p><p>3,G代码说明:G00 定位(快速进给) G01直线切削 G02圆弧切削顺时针 G03 圆弧切削反时针 G04暂停 G33螺纹切削 G39转角补正圆弧切削 G40刀具补正消除 G41刀具补正（左侧）G42刀具补正（右侧）G43刀具长补正（+）G44刀具长补正（—）G49刀具补正消除G54工作坐标系1选择G62自动转角调整 G64切削模式 G90绝对指令 G94每分钟进给 G95每转进给</p><p>M功能说明：M00程式停止M01选择停止M02程式结束M03主轴正转M04主轴反转M30程式结束及复置。</p><p>是实际使用的，只要达到目的就行，可以循环渐进铣，也可以一次进刀到位铣一次。比如我要铣15深可以一次下刀15，也可以每次进刀3循环铣渐进5次刀.</p><p>谢谢ZZXXQQ兄了。</p> <p>G80是什么含义？</p><p>G43 H43是什么含义？</p><p>M06 T16是换刀吗？</p>