独立地物及文字重复检查结果有问题?
;独立地物及文字重复检查(defun c:tt ()
(setq del-lst nil)
(command "zoom" "e")
(setq all-pline (ssget "C" (getvar "extmin") (getvar "extmax")
'((-4 . "<or")
(0 . "insert")
(0 . "point")
(0 . "text")
(-4 . "or>")
)
)
)
(if (not all-pline)
(progn (alert "\n没有任何独立地物点或文字") (exit))
)
(setq flag (getint "\n(1)对属性相同的自动删除 (2)全部聚焦地物 <2>:"))
(if (not flag) (setq flag 2))
(setq i 0)
(setq error-len 0.5);最小读物间隔
(repeat (sslength all-pline)
(setq one-name (ssname all-pline i))
(setq one-dat (entget one-name '("south")))
(if one-dat
(progn
(setq source-xdat (assoc -3 one-dat))
(if source-xdat (setq source-xdat (cdr (assoc 1000 (cdadr source-xdat)))));地码编码
(setq one-type (cdr (assoc 0 one-dat)));地物类型,是独立地物还是文字
(setq id-1 (cdr (assoc 5 one-dat)));实体句柄
(setq ptt (cdr (assoc 10 one-dat)))
(setq p1 (list (+ (car ptt) 5) (+ (cadr ptt) 5)) p2 (list (- (car ptt) 5) (- (cadr ptt) 5)))
(command "zoom" p1 p2)
(setq p1 (list (+ (car ptt) error-len) (+ (cadr ptt) error-len))
p2 (list (- (car ptt) error-len) (- (cadr ptt) error-len))
)
(setq one-lst (ssget "C" p1 p2 '((-4 . "<or")
(0 . "insert")
(0 . "text")
(-4 . "or>")
)
)
)
(setq j 0)
(if (and one-lst (> (sslength one-lst) 1))
(repeat (sslength one-lst)
(progn
(setq one-name-1 (ssname one-lst j))
(if (not (assoc one-name del-lst));如果不在删除列表里
(progn
(setq one-dat-1 (entget one-name-1 '("south")))
(setq id-2 (cdr (assoc 5 one-dat-1)));实体句柄
(setq source-xdat-1 (assoc -3 one-dat-1))
(if source-xdat-1
(setq source-xdat-1 (cdr (assoc 1000 (cdadr source-xdat-1))))
)
(setq one-type-1 (cdr (assoc 0 one-dat-1)))
(setq ptt-1 (cdr (assoc 10 one-dat-1)))
(if (and (= one-type "INSERT")
(= one-type one-type-1)
(= source-xdat source-xdat-1)
(/= id-1 id-2)
(= flag 1)
(< (- (caddr ptt) (caddr ptt-1)) 0.01)
)
(setq del-lst (cons (cons one-name-1 j) del-lst))
)
(if (and (= one-type "INSERT")
(= one-type one-type-1)
(= source-xdat source-xdat-1)
(/= id-1 id-2)
(= flag 2)
(< (- (caddr ptt) (caddr ptt-1)) 0.01)
)
(progn
(alert (strcat "\n存在代码相同重复的独立地物点\n地物代码为:" source-xdat))
(exit)
)
)
(if (and (= one-type "TEXT")
(= one-type one-type-1)
(= source-xdat source-xdat-1)
(/= id-1 id-2)
(= flag 1)
(= (cdr (assoc 1 one-dat-1)) (cdr (assoc 1 one-dat)))
(< (- (caddr ptt) (caddr ptt-1)) 0.01)
)
(setq del-lst (cons (cons one-name-1 j) del-lst))
)
(if (and (= one-type "TEXT")
(= one-type one-type-1)
(= source-xdat source-xdat-1)
(/= id-1 id-2)
(= flag 2)
(= (cdr (assoc 1 one-dat-1)) (cdr (assoc 1 one-dat)))
(< (- (caddr ptt) (caddr ptt-1)) 0.01)
)
(progn
(alert "\n存在文字相同重复的文字注记")
(exit)
)
)
)
);end (if (not (assoc one-name-1 del-lst)))
(setq j (1+ j))
)
);end (repeat (sslength one-lst))
)
)
(setq i (1+ i))
)
(setq i 0)
(repeat (length del-lst)
(entdel (car (nth i del-lst)))
(setq i (1+ i))
)
)
(command "zoom" "e")
(alert "\n独立地物点及文字重复检查及改正成功!!!")
) 俺菜!!调试不出来,高手帮看看,先谢谢了
页:
[1]