CAD83 发表于 2008-7-16 21:51:00

[求助]ZZXXQQ能帮我编个可以是删除或改变层同一种圆孔的LSIP吗

ZZXXQQ，能帮我编个可以是删除或改变层同一种圆孔的LIsP吗?急用，谢谢！！

ZZXXQQ 发表于 2008-7-16 23:04:00

本帖最后由 作者 于 2008-11-9 20:36:03 编辑


;删除图中同层中所选同样直径的圆 明经 ZZXXQQ 2008.7.16-2008.11.9
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (princ "\nSelect Circle(s) 选择圆:")
          (setq ss (ssget '((0 . "CIRCLE"))))) (progn
(setq i 0)
(repeat (sslength ss)
   (setq en (ssname ss i)
         ent (entget en)
         rl (assoc 40 ent)
         lnml (assoc 8 ent)
         i (1+ i))
   (if (> (sslength (setq ss1 (ssget "X" (list '(0 . "CIRCLE") lnml rl)))) 1)
    (command ".erase" ss1 "")
   )
)
))
(setvar "CMDECHO" 1)
(princ)
)

;改变同层中同直径圆的直径 明经 ZZXXQQ 2008.7.16
(defun c:tt ()
(if (and (princ "\nSelect Circle(s) 选择圆:")
          (setq ss (ssget '((0 . "CIRCLE"))))) (progn
(setq i 0)
(repeat (sslength ss)
   (setq en (ssname ss i)
         ent (entget en)
         rl (assoc 40 ent)
         lnml (assoc 8 ent)
         i (1+ i))
   (setq ss1 (ssget "X" (list '(0 . "CIRCLE") lnml rl)))
   (setq r1 (assoc 40 ent))
   (if (setq newd (getdist(strcat "\nNew diameter 新直径<" (rtos (* (cdr r1) 2) 2 4) ">:"))) (progn
    (setq j 0)
(repeat (sslength ss1)
(setq ent1 (entget(ssname ss1 j))
         ent1 (subst (cons 40 (/ newd 2)) (assoc 40 ent1) ent1)
         j (1+ j))
   (entmod ent1)
    )
   ))
)
))
(princ)
)

CAD83 发表于 2008-7-17 08:34:00

本帖最后由 作者 于 2008-7-17 8:37:36 编辑

改变同层中同直径圆的直径在cad2007不能用,改同层直径后（或不改大小时）都可以自动改变到新开的一层，能再帮改下吗？谢谢ZZXXQQ!!!

coolpoom 发表于 2008-11-9 17:21:00

以上两程式在2004出错

ZZXXQQ 发表于 2008-11-9 20:37:00

2楼已改，再试试。

coolpoom 发表于 2008-11-10 11:17:00

删除同一种圆孔的LISP 如果能做到点击某一圆就自动删除且在命令行提示图层与孔径就好多了，不用点选之后还要回车来确认！

coolpoom 发表于 2008-11-10 14:25:00

本人刚改了一下程式：
;删除图中同层中所选同样直径的圆
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (and (setq dd (entsel "选取已知圆:")))
    (progn
    (setq ss (entget (car dd))
            rl (assoc 40 ss)
            lnml (assoc 8 ss))
    (if (> (sslength (setq ss1 (ssget "X" (list '(0 . "CIRCLE") lnml rl)))) 1)
   (command ".erase" ss1 "")
    )
))
(setq rad (cdr rl))
(setq lad (cdr lnml))
(setq num1 (sslength ss1))
(print
(strcat "已删除" lad "层及直径=" (rtos rad 2 3) "的圆" (rtos num1 2 0) "个"))
(setvar "CMDECHO" 1)
(princ)
)
页: [1]
查看完整版本: [求助]ZZXXQQ能帮我编个可以是删除或改变层同一种圆孔的LSIP吗