【已解决】lisp删去重复物体运行错误，不知哪里错了！

75215195

(defun c:dele ();command命令
  (command "-layer" "on" "*" "") ;显示所有层
  (command "zoom" "e" "zoom" "0.9x");所有实体显示在当前窗口中
  (prompt "\n<<请选择要检查的实体>>")
  (setq aa (ssget)) ;建立要处理的实体选择集
  (setq cfst (ssadd));建立重复实体空选择集
  (setq i 0)
  (while (< i (sslength aa));循环
(setq en (ssname aa i));取得要处理的实体的图元名称
  (setq pt1 (getPoint en 1));取得图元左下坐标
  (setq pt9 (getPoint en 9));取得图元右上坐标
(setq xzjst (ssget "C" pt9 pt1));取得框选所有图元
(setq xzjst (ssdel en xzjst));从选择集中去掉原来图元
(setq endata (entget en)) ;取得图元组码
(setq stmc (cdr (assoc 0 endata))) ;取得图元实体类型
(setq i (1+ i) j 0)
  (princ (strcat "\n正在检查第<<"(itoa i)">>个实体,请稍后。。。"))  
  (while (< j (sslength xzjst));测试框选所有图元
(setq en1 (ssname xzjst j))
(setq endata1 (entget en1))                    
(setq stmc1 (cdr (assoc 0 endata1)))
(cond ((and (= stmc1 "INSERT") (= stmc "INSERT"));测试块
(setq km (cdr (assoc 2 endata))) ;图块名称
(setq pt (cdr (assoc 10 endata))) ;图块插入点
(setq jd (cdr (assoc 50 endata)));图块旋转角度
(setq tcm (cdr (assoc 8 endata))) ;图层
(setq km1 (cdr (assoc 2 endata1)))
(setq pt1 (cdr (assoc 10 endata1)))
(setq jd1 (cdr (assoc 50 endata1)))
(setq tcm1 (cdr (assoc 8 endata1)))
(if (and (= km km1) (equal jd jd1 0.0001) (= tcm tcm1)
(equal pt pt1 0.0001)) ;对比条件
(prong ;条件成立
(setq cfst (ssadd en1 cfst)) ;把重复实体加入重复选择集
(setq aa (ssdel en1 aa))
)
)
)
;测试圆弧、圆、线段、文字等等
((and (= stmc1 "LWPOLYLINE") (= stmc "LWPOLYLINE")) ;测试PL线
(setq dds (cdr (assoc 90 endata))) ;顶点数
(setq tcm (cdr (assoc 8 endata)));图层
(setq tym (cdr (assoc -1 endata)))
(setq zblb (vertexs tym)) ;顶点坐标联合列表
(setq dds1 (cdr (assoc 90 endata1)))
(setq tcm1 (cdr (assoc 8 endata1)))
(setq tym1 (cdr (assoc -1 endata1)))
(setq zblb1 (vertexs tym1))
(if (and (= dds dds1) (= tcm tcm1)
(equal zblb zblb1 0.0001))
(progn
(setq cfst (ssadd en1 cfst))
(setq aa (ssdel en1 aa))
)
)
)
(t)
)
(setq j (1+ j))
)
)
(if (/= (sslength cfst) 0)
(progn
(command "erase" cfst "") ;删除重复实体
(princ (strcat "\n共删除个重复实体!" ))
)
)
(princ "\n没有发现重复实体!")
)

/db_自贡黄明儒_

(setq pt1 (getPoint en 1));取得图元左下坐标

75215195

/db_自贡黄明儒_ 发表于 2017-7-15 12:08

怎么改？我不怎么懂！

/db_自贡黄明儒_

75215195 发表于 2017-7-15 12:39

不知道怎么改，就用下面的，你那个太复杂了

1. (DEFUN C:dele (/ DXF E EN LST N SS)
   
2.   (setq dxf '(-1 5 330))
   
3.   (while (setq ss (ssget))
   
4.     (setq lst nil)
   
5.     (repeat (setq n (sslength ss))
   
6.       (setq e (ssname ss (setq n (1- n))))
   
7.       (setq en
   
8.              (vl-remove-if '(lambda (x) (member (car x) dxf)) (entget e))
   
9.       )
   
10.       (cond ((member en lst) (entdel e))
    
11.             (T (setq lst (cons en lst)))
    
12.       )
    
13.     )
    
14.   )
    
15.   (princ)
    
16. )
    

(DEFUN C:dele (/ DXF E EN LST N SS)<br />   (setq dxf '(-1 5 330))<br />   (while (setq ss (ssget))<br />     (setq lst nil)<br />     (repeat (setq n (sslength ss))<br />       (setq e (ssname ss (setq n (1- n))))<br />       (setq en<br />              (vl-remove-if '(lambda (x) (member (car x) dxf)) (entget e))<br />       )<br />       (cond ((member en lst) (entdel e))<br />             (T (setq lst (cons en lst)))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />