各位请修改不用框选，执行命读写0层不。

啊业_48384

(defun c:nc()
  (setvar "CMDECHO" 0)
  (if (setq ss (ssget '((0 . "CIRCLE")))) (progn
   (command ".UNDO" "BE")
   (setq i -1  cirlst (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)
)

linheyuanpcb

(defun c:ncb()
  (setvar "CMDECHO" 0)
  (if (setq ss(ssget "X" (list '(0 . "circle") (cons 8 "0")))) (progn
   (command ".UNDO" "BE")
   (setq i -1  cirlst (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 ss1(ssget "X" (list '(0 . "circle") (cons 8 "0"))))
    (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)
)

啊业_48384

linheyuanpcb 发表于 2018-12-7 10:04
(defun c:ncb()
  (setvar "CMDECHO" 0)
  (if (setq ss(ssget "X" (list '(0 . "circle") (cons 8 "0")) ...

没有0层不提示的呢？？

啊业_48384

linheyuanpcb 发表于 2018-12-11 19:20
如果0层是空，退出程序
(if(=(setq ss (ssget "x" '((0 . "*CIRCLE") (8 . "0"))))nil)
(setq sslayer (s ...

读孔每种孔都循环一次，好多孔呀
你转来看下，我附件了

evayleung

重复发贴了吧。。。。。。

啊业_48384

linheyuanpcb 发表于 2018-12-7 10:04
(defun c:ncb()
  (setvar "CMDECHO" 0)
  (if (setq ss(ssget "X" (list '(0 . "circle") (cons 8 "0")) ...

谢谢！！！linheyuanpcb

啊业_48384

linheyuanpcb 发表于 2018-12-7 10:04
(defun c:ncb()
  (setvar "CMDECHO" 0)
  (if (setq ss(ssget "X" (list '(0 . "circle") (cons 8 "0")) ...

谢谢！！！linheyuanpcb

啊业_48384

linheyuanpcb 发表于 2018-12-7 10:04
(defun c:ncb()
  (setvar "CMDECHO" 0)
  (if (setq ss(ssget "X" (list '(0 . "circle") (cons 8 "0")) ...

没有0层不提示呢

linheyuanpcb

(if(=(setq ss (ssget "x" '((0 . "*CIRCLE") (8 . "0"))))nil)
(setq sslayer (ssadd))
)

linheyuanpcb

如果0层是空，退出程序
(if(=(setq ss (ssget "x" '((0 . "*CIRCLE") (8 . "0"))))nil)
(setq sslayer (ssadd))
(exit)
)