(defun c:db()
(setvar "cmdecho" 0)
(setq FN (getvar "dwgname")); PCB1234MT.dwg
(setq n 1 k 0)
(While (> n 0)
(setq Tac (vl-string-elt FN k))
(if (and (> Tac 47)(< Tac 58));0是48,9是57
(setq n 0)
(setq k (1+ k))
)
)
(setq FN (substr FN (+ k 1)))
(setq n 1 k 0)
(While (> n 0)
(setq Tac (vl-string-elt FN k))
(if (> Tac 64);65是大写字母A
(setq n 0)
(setq k (1+ k))
)
)
(setq FN (substr FN 1 k))
(setq file2 (strcat "C:\\NC\\" FN "p.NC"))
;(setq file2 (getstring "\n 请输入路径及文件名"))
(setq file3(open file2 "w"))
(if(= file3 nil)
(progn
(alert"路径或文件名错误!")
(exit)
)
)
(princ "请选择要钻孔的圆：")
(setq a (ssget))
(setq n (sslength a))
(setq i 0 m 0 Lzb nil)
(repeat n
(setq en(ssname a i))
(setq endata(entget en))
(setq entype(cdr (assoc 0 endata)))
(if(= entype "CIRCLE")
(progn
(setq ZB (cdr(assoc 10 endata)))
(setq Lzb (cons ZB Lzb))
(setq x(cadr(assoc 10 endata)))
(setq y(caddr(assoc 10 endata)))
(princ "X" file3)
(princ (rtos x 2 3) file3)
(princ "" file3)
(princ "Y" file3)
(princ (rtos y 2 3) file3)
(princ "\n" file3)
(setq m (+ 1 m))
)
)
(setq i (+ 1 i))
)
(princ (strcat "\n共有<" (itoa m) ">孔被选取!"))
(prin1)
(close file3)
(setq R_c (cdr(assoc 40 endata)))
(setq Tzb1(Last Lzb))
(setq Tzb2 (last (reverse Lzb)))
(setq Txzb (- (* 1.5 (car Tzb1)) (* 0.5 (car Tzb2))))
(setq Tyzb (* 0.5 (+ (cadr Tzb2) (cadr Tzb1))))
(setq Tzb (list Txzb Tyzb))
(prin1)
;;;;写字： PCB板钻孔文件为FN;;;;;;;;
(setq Txt (strcat "PCB板钻孔文件为" FN "P.NC"))
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbTexe")
(cons 62 6);颜色粉红
(cons 10 Tzb)
(cons 40 (/ R_c 3));字高2.5
(cons 7"standard")
(cons 1Txt)
)
)
) 看一下是不是你想要的
(defun c:db(/ a en endata entype file2 file3 i m n pt x y)
(setvar "cmdecho" 0)
(setq file2 (strcat "c:/Nc/"(vl-string-right-trim ".dwg"(getvar "DWGNAME")) "P.nc"))
(setq file3(open file2 "w"))
(if(= file3 nil)
(progn
(alert"路径或文件名错误!")
(exit)
)
)
(princ "请选择要钻孔的圆：")
(setq a (ssget))
(setq n (sslength a))
(setq i 0 m 0)
(repeat n
(setq en(ssname a i))
(setq endata(entget en))
(setq entype(cdr (assoc 0 endata)))
(if(= entype "CIRCLE")
(progn
(setq x(cadr(assoc 10 endata)))
(setq y(caddr(assoc 10 endata)))
(princ "X" file3)
(princ (rtos x 2 3) file3)
(princ "" file3)
(princ "Y" file3)
(princ (rtos y 2 3) file3)
(princ "\n" file3)
(setq m (+ 1 m))
)
)
(setq i (+ 1 i))
)
(princ (strcat "\n共有<" (itoa m) ">孔被选取!"))
(close file3)
(if (setq pt (getpoint "\n文字放置点: "))
(entmakeX (list '(0 . "TEXT") (cons 1 (strcat (vl-string-right-trim ".dwg"(getvar "DWGNAME")) "P.nc")) (cons 10 pt) (cons 40 5) (cons 62 1)))
)
(prin1)
)
ntwison 发表于 2018-4-21 20:14
(defun c:db()
(setvar "cmdecho" 0)
(setq FN (getvar "dwgname")); PCB1234MT.dwg
非常感谢。谢谢 xiaolong1487 发表于 2018-4-22 08:38
看一下是不是你想要的
(defun c:db(/ a en endata entype file2 file3 i m n pt x y)
(setvar "cmdecho" ...
输出的文件名没达到，不过会员 ntwison 已帮我搞定。还是非常感谢你 Andyhon 发表于 2018-4-21 18:16
(setq file7 (getstring (strcat "\nDefault-->" file2 " OK?")))
(cond
((= file7 ""))
非常感谢，符合我的使用 这个东西，写出去，是不是还要加文件头，文件尾啊？
孔径不同的在一起，咋处理啊？
(ssget (list (cons 0 "CIRCLE")))
选实体的时候，变成上面的这样，就只选圆了。
后面的用repeat也好，while循环也好，直接处理了。不在需要进行判断是否为圆了。
在搜一搜，坐标排序，这样的话，你的NC程序，虽然简单，但是钻孔时，就是按最短路径加工了。 前生 发表于 2018-4-24 23:34
(ssget (list (cons 0 "CIRCLE")))
选实体的时候，变成上面的这样，就只选圆了。
后面的用repeat也好，wh ...
这个程式只用于天马机钻孔而已，只需一种钻嘴，开头和结束，天马软件会识别。
以下这个可以分孔径大小，镭铭机钻孔用，照参各位大神的提示修改文件名。
兄弟机不能用，除非另外软件改写。再说我厂也没兄弟机，所以没有源代码。
(defun c:nc()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "CIRCLE")))) (progn
(command ".UNDO" "BE")
(setq i -1cirlst (list))
(repeat (sslength ss)
(setq r (cdr (assoc 40 (entget (setq en (ssname ss (setq i (1+ i))))))))
(if (assoc r cirlst)
(setq cirlst (subst (cons r (1+ (cdr (assoc r cirlst)))) (assoc r cirlst) cirlst))
(setq cirlst (cons (cons r 1) cirlst))
)
)
(setq i -1 cirlst (reverse cirlst) cclist (list))
(setq cirlst (vl-sort cirlst (function (lambda (e1 e2) (> (car e1) (car e2))))))
(repeat (length cirlst)
(setq r (car (nth (setq i (1+ i)) cirlst)))
(command "select" ss "")
(setq ss1 (ssget "P" (list (cons 0 "CIRCLE") (cons 40 r))))
(setq j 0 clist (list r))
(repeat (sslength ss1)
(setq ent (entget(ssname ss1 j)))
(setq j (1+ j))
(setq pc (cdr(assoc 10 ent)))
(setq clist (append clist (list (list (car pc) (cadr pc)))))
)
(setq cclist (cons clist cclist))
)
(setq nm (if nm nm ""))
(if (setq nm (getfiled "输入文件名" nm "drl" 1)) (progn
(setq i 0)
(setq fp (open nm "w"))
(princ "M48\nMETRIC\nVER,1\nFMAT,2\n" fp)
(repeat (length cclist)
(setq r (car(nth i cclist)))
(setq i (1+ i))
(princ (strcat "T" (if (< i 10) "0" "") (itoa i) "C" (rtos (+ r r) 2 3) "F423B423S6H1800\n") fp)
)
(princ "DETECT,ON\nATC,ON\n%\n" fp)
(setq i 0)
(repeat (length cclist)
(setq clist (nth i cclist) i (1+ i))
(princ (strcat "T" (if (< i 10) "0" "") (itoa i) "\n") fp)
(setq j 0 clist (cdr clist))
(repeat (length clist)
(setq pc (nth j clist) j (1+ j))
(princ (strcat "X" (rtos (car pc) 2 3) "Y" (rtos (cadr pc) 2 3) "\n") fp)
)
)
(princ "M30\n%\n" fp)
(close fp)
))
(command ".UNDO" "E")
))
(setvar "CMDECHO" 1)
(princ)
)
我知你是那个人了，叫我改呀。:P
页:
1
[2]