[弹指神通]：能用lisp编写删除同一文件中重复的块吗？

zwf9900

*-*b 在实际工作中，经常会用到块，但有时用重复插入了，能用lisp编写删除同一文件中重复的块吗？只留一个就可以了！其余的删除

zxq0220

[php]
;删除重复块 晓东 zxq0220 2008.7.11
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget "X" '((0 . "INSERT")))) (progn
  (setq i 0 ess (list))
  (repeat (sslength ss)
   (setq s1 (ssname ss i)
         ent (entget s1)
         ss1 (ssget "X" (list '(0 . "INSERT") (assoc 2 ent))))
   (if (> (sslength ss1) 1) (setq ss1 (ssdel s1) ess (cons ss1 ess)))
   (setq i (1+ i))
  )
  (setq i 0)
  (command ".erase")
  (repeat (length ess)
   (command (nth i ess))
   (setq i (1+ i))
  )
  (command "")
))
(setvar "CMDECHO" 1)
(princ)
)
[/php]

zwf9900

谢谢楼主的程序，回家试试去！

yoyoho

楼主阿!
删除重复块测试不能运行阿!
麻烦楼主查看!

xyp1964

2. [FONT=courier new];; 需要通用函数XYPLib.vlx的支持
   
3. (defun c:test ()
   
4.   (CMDLA0)
   
5.   (setq        ss  (ssget '((0 . "INSERT")))
   
6.         lst '()
   
7.         ss0 (ssadd)
   
8.         i   -1
   
9.   )
   
10.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.     (setq bn (xyp-get-dxf 2 s1))
    
12.     (if        (member bn lst)
    
13.       (setq ss0 (ssadd s1 ss0))
    
14.       (setq lst (cons bn lst))
    
15.     )
    
16.   )
    
17.   (if ss0
    
18.     (command "erase" ss0 "")
    
19.   )
    
20.   (CMDLA1)
    
21. )[/FONT]

[FONT=courier new];; 需要通用函数XYPLib.vlx的支持<br /> (defun c:test ()<br />   (CMDLA0)<br />   (setq        ss  (ssget '((0 . "INSERT")))<br />         lst '()<br />         ss0 (ssadd)<br />         i   -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq bn (xyp-get-dxf 2 s1))<br />     (if        (member bn lst)<br />       (setq ss0 (ssadd s1 ss0))<br />       (setq lst (cons bn lst))<br />     )<br />   )<br />   (if ss0<br />     (command "erase" ss0 "")<br />   )<br />   (CMDLA1)<br /> )[/FONT]

逐月飞鸿

xyp1964  版主是一个高手

foride

最初由 逐月飞鸿 发布
[B]xyp1964  版主是一个高手 [/B]

可以帮助我也编个程序么，在另外一个（程序申请里），都这么长时间了，都没有人出手，哎*-*a

rthzg

最初由 danielwang321 发布
[B]看不东 [/B]

可以直接用就行哦！

谢谢斑竹！