各位请帮忙修改不用框选，执行命读写0层不
(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)
)
本帖最后由 lifuq1979 于 2018-12-18 19:00 编辑
(setq ss (ssget '((0 . "CIRCLE"))))改成(setq ss (ssget "x" '((0 . "CIRCLE")(8 . "0")))) lifuq1979 发表于 2018-12-18 18:57
(setq ss (ssget '((0 . "CIRCLE"))))改成(setq ss (ssget "x" '((0 . "CIRCLE")(8 . "0"))))
会重复读孔 执行结果与原程序一样，只是少了选择那个步骤，什么为重复读孔？？
页:
[1]