[求助]一个删除重复块程序运行有问题,麻烦高手查看!

jxlsp

这样好象不重叠的块也要删除了.

ZZXXQQ

liminnet发表于2008-10-6 10:14:00ZZXXQQ大哥，问个问题，删掉重叠的块的原理是什么呀，为什么你五楼的代码中 ss1 (ssget \"X\" (list '(0 . \"INSERT\") (assoc 2 ent))))这句是怎么样知道它们是重叠

程序是删重复块，不是重叠块。就是说程序运行后在当前图形内的任何块都只有一个。

byghbcx

jxlsp发表于2008-10-6 12:44:00这样好象不重叠的块也要删除了.

是要删除重叠多余的，重叠处只留一个吗？这样可以吗

2. ;删除重复块 晓东 zxq0220 2008.7.11                                                  
3. (defun c:BKILL ()                                                                  
4. (setvar "CMDECHO" 0)                                                               
5. (if (setq ss (ssget "X" '((0 . "INSERT"))))
6.   (progn                                 
7.   (setq i 0  ess (ssadd))                                                            
8.   (repeat (sslength ss)                                                            
9.    (setq s1 (ssname ss i)                                                           
10.          ent (entget s1)
11.   j 0
12.   ptlist '()
13.          ss1 (ssget "X" (list '(0 . "INSERT") (assoc 2 ent))))                     
14.    (if (> (sslength ss1) 1)
15.      (repeat (sslength ss1)
16.        (setq en (ssname ss1 j))
17.        (setq pt (cdr (assoc 10 (entget en))))
18.        (if (member pt ptlist) (setq ess (ssadd en ess)) (setq ptlist (cons pt ptlist)))
19.        (setq j (1+ j))
20.      )
21.      )               
22.    (setq i (1+ i))                                                                  
23.   )                                                                                 
24. (command ".erase" ess "")                                                               
25. ))                                                                                 
26. (setvar "CMDECHO" 1)                                                               
27. (princ)                                                                             
28. )

;删除重复块 晓东 zxq0220 2008.7.11                                                   (defun c:BKILL ()                                                                   (setvar "CMDECHO" 0)                                                                (if (setq ss (ssget "X" '((0 . "INSERT"))))   (progn                                    (setq i 0  ess (ssadd))                                                               (repeat (sslength ss)                                                                (setq s1 (ssname ss i)                                                                     ent (entget s1)   j 0   ptlist '()          ss1 (ssget "X" (list '(0 . "INSERT") (assoc 2 ent))))                         (if (> (sslength ss1) 1)      (repeat (sslength ss1)        (setq en (ssname ss1 j))        (setq pt (cdr (assoc 10 (entget en))))        (if (member pt ptlist) (setq ess (ssadd en ess)) (setq ptlist (cons pt ptlist)))        (setq j (1+ j))      )      )                   (setq i (1+ i))                                                                     )                                                                                  (command ".erase" ess "")                                                                ))                                                                                  (setvar "CMDECHO" 1)                                                                (princ)                                                                              )

jxlsp

1. 以下是引用byghbcx在2008-10-7 8:51:00的发言：

复制代码

就是这样子,写得很好,可以借鉴写个删除线的.

写得真不错，呵呵谢谢了

xujinhua

谢谢啊..很好用。。。

youfei

支持一下

古镇画板设计@林

谢谢分享！

panliang9

战役期间，好贴标记！