蓝图测绘 发表于 2013-10-28 15:07:00

检查重复的同名注记，自己写的，新手，有改进空间

检查图上的注记是否有重名的（比如：宗地编号、控制点名称等），只在同一个图层、字体、字高等都一样的注记之间查找，不同类型的同名注记不算重复。
(defun c:jc()
(setvar "cmdecho" 0)
(setq os (getvar "OSMODE"))
(setq lay (getvar "clayer"))
(setq txtlx (entget (car (entsel "\n====选择一个文字作为类型样本:"))))
(setq layer (cdr (assoc 8 txtlx)))
(setq color (cdr (assoc 62 txtlx)))
(setq style (cdr (assoc 7 txtlx)))
(setq txtsiz (cdr (assoc 40 txtlx)))
(setq txtbl (cdr (assoc 41 txtlx)))
(princ "\n")
(princ "\n====请选择需要检查的文字:")
(if (= color nil)
    (setq ss (ssget (list '(0 . "TEXT") (cons 8 layer) (cons 7style) (cons 40 txtsiz) (cons 41 txtbl))))
    (setq ss (ssget (list '(0 . "TEXT") (cons 8 layer) (cons 62 color) (cons 7style) (cons 40 txtsiz) (cons 41 txtbl))))
)
(princ "\n")
(setq i 0)
(setq m 0)
(repeat (setq cd (sslength ss))
    (setq ss1 (ssname ss i))
    (setq ss1data (entget ss1))
    (setq pt1 (cdr (assoc 10 ss1data)))
    (setq txt1 (cdr (assoc 1 ss1data)))
    (setq n (1+ i))
    (while (< n cd)
      (setq ssn (ssname ss n))
      (setq ssdata (entget ssn))
      (setq ptn (cdr (assoc 10 ssdata)))
      (setq txtn (cdr (assoc 1 ssdata)))
      (if (= txt1 txtn)
      (progn
          (setq m (1+ m))         
          (command "color" m)
          (command "layer" "m" "cfjc" "" "" "" "")
          (command"_circLe" pt1 "2")
          (command"_circLe" ptn "2")
      )
      )
      (setq n (1+ n))
    )
    (setq n 0)
    (setq i (1+ i))
)
(command "cecolor" "bylayer")
(command "layer" "s" lay "")
(setvar "OSMODE" os)
(if (= m 0)
    (alert
    "\n   恭喜你，检查合格
   \n   未发现相同的注记")
    (alert
   (strcat "\n本次检查共发现 " (rtos m 2 0) " 对相同注记"))
)
(prin1)
)
(princ "\n====蓝图测绘，精心制作; 键入 jc 运行本插件====")   

llsheng_73 发表于 2013-10-30 11:37:43

本帖最后由 llsheng_73 于 2013-10-30 11:38 编辑

(setq txtlx (entget (car (entsel "\n====选择一个文字作为类型样本:"))))
   (setq layer (cdr (assoc 8 txtlx)))
   (setq color (cdr (assoc 62 txtlx)))
   (setq style (cdr (assoc 7 txtlx)))
   (setq txtsiz (cdr (assoc 40 txtlx)))
   (setq txtbl (cdr (assoc 41 txtlx)))
上边除了绿色标出的一句都可能会出错
(setq txtlx (entget (car (entsel "\n====选择一个文字作为类型样本:"))))
会在不小心没选中任何图元直接按了右键时它是要出错的
可以处理一下(while(null(setq txtlx(car(entsel "\n====选择一个文字作为类型样本:")))))
这是解决了不会允许空输入，但后边还可能出错，因这前边虽然提示了“选择文字”，但实际操作起来是不是就不会选到别的呢？显然这是无法保证的。当所选对象不是TEXT或者MTEXT的时候，(setq style (cdr (assoc 7 txtlx)))一定出错，因为这是个非文字图元不会有的一个组码，后边40,41也一般会因些出错
所以，为了防止出错中断，必须先检查它是不是TEXT或者MTEXT

蓝图测绘 发表于 2013-10-30 21:01:25

受益匪浅，你说的这些看书是学不到的，都是经验啊，谢谢

chenbh2 发表于 2014-9-10 19:55:59

收藏备用!感谢!

xiabin68 发表于 2014-11-9 23:33:28

收录了，，好东西，，，，，，，，

18112600842 发表于 2024-3-2 14:59:12

收藏备用!感谢!
页: [1]
查看完整版本: 检查重复的同名注记，自己写的，新手，有改进空间