明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1646|回复: 1

[基础] 独立地物及文字重复检查结果有问题?

[复制链接]
发表于 2011-1-3 15:11:22 | 显示全部楼层 |阅读模式
;独立地物及文字重复检查
(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独立地物点及文字重复检查及改正成功!!!")
)
"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2011-1-3 15:13:32 | 显示全部楼层
俺菜!!调试不出来,高手帮看看,先谢谢了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-10-2 18:20 , Processed in 0.158552 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表