删除重叠的相同文字

eachy · 发表于 2014-11-11 17:01:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:xdtb_deloverlaptext (/ ss e lst)
(if
(and
(setq e (car (xdrx_entsel "\n拾取文字: " '((0 . "text")))))
(setq d (getdist "\n误差范围: "))
(progn
(princ "\n选择范围<回车全选>...")
(if (setq ss (ssget (list '(0 . "text") (assoc 8 (entget e)))))
ss
(setq
ss (ssget "X" (list '(0 . "text") (assoc 8 (entget e))))
)
)
)
)
(progn
(xd::begin)
(setq lst (mapcar
'(lambda (x)
(reverse
(cons
x
(xdrx_getpropertyvalue x "textstring" "position")
)
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst d)
)
(mapcar '(lambda (x / sl)
(if (> (length x) 1)
(progn
(setq sl (mapcar 'car x))
(if (apply '= sl)
(mapcar 'entdel (cdr (mapcar 'cadr x)))
(progn
(setq nl (xd::list:groupbyindex x 0))
(mapcar '(lambda (a)
(if (> (length a) 1)
(mapcar 'entdel (cdr a))
)
)
(mapcar 'cdr nl)
)
)
)
)
)
)
(mapcar 'cdr lst)
)
(xd::end)
)
)
(princ)
)

(defun c:xdtb_deloverlaptext (/ ss e lst) 
  (if 
    (and 
      (setq e (car (xdrx_entsel "\n拾取文字: " '((0 . "text"))))) 
      (setq d (getdist "\n误差范围: ")) 
      (progn 
        (princ "\n选择范围<回车全选>...") 
        (if (setq ss (ssget (list '(0 . "text") (assoc 8 (entget e))))) 
          ss 
          (setq 
            ss (ssget "X" (list '(0 . "text") (assoc 8 (entget e)))) 
          ) 
        ) 
      ) 
    ) 
     (progn 
       (xd::begin) 
       (setq lst (mapcar 
                   '(lambda (x) 
                      (reverse 
                        (cons 
                          x 
                          (xdrx_getpropertyvalue x "textstring" "position") 
                        ) 
                      ) 
                    ) 
                   (xdrx_pickset->ents ss) 
                 ) 
             lst (xd::list:groupbyindex lst d) 
       ) 
       (mapcar '(lambda        (x / sl) 
                  (if (> (length x) 1) 
                    (progn 
                      (setq sl (mapcar 'car x)) 
                      (if (apply '= sl) 
                        (mapcar 'entdel (cdr (mapcar 'cadr x))) 
                        (progn 
                          (setq nl (xd::list:groupbyindex x 0)) 
                          (mapcar '(lambda (a) 
                                     (if (> (length a) 1) 
                                       (mapcar 'entdel (cdr a)) 
                                     ) 
                                   ) 
                                  (mapcar 'cdr nl) 
                          ) 
                        ) 
                      ) 
                    ) 
                  ) 
                ) 
               (mapcar 'cdr lst) 
       ) 
       (xd::end) 
     ) 
  ) 
  (princ) 
)

lizhiqiang9801 · 发表于 2014-11-12 09:49:57

顶贴程序强大实用

akilahe · 发表于 2014-11-12 17:01:23

代码该如何使用吖？

iLisp · 发表于 2014-11-12 18:02:10

akilahe 发表于 2014-11-12 17:01
代码该如何使用吖？

这可说来话长了，往上看帖子

grs432 · 发表于 2014-11-13 10:26:38

不错的工具

kkt123 · 发表于 2015-2-26 12:32:22

代码该如何使用吖？;P

jblwk · 发表于 2015-3-5 13:17:00

hao xiexie

bjcwyz · 发表于 2015-3-5 18:55:17

不错，不错！有点意思呢。

revelant · 发表于 2015-3-11 10:41:42

好东西，下载试用一下

vlisp2012 · 发表于 2015-5-18 21:18:12

就是没有子程序啊！:funk::funk::funk:

天若有情007 · 发表于 2016-3-29 13:23:13

不错，学习学习

zhouzhiy · 发表于 2017-3-27 06:59:14

谢谢楼主分享！

dyjwyqz5221 · 发表于 2018-5-15 08:56:01

不错不错，学习学习，正准备设计这一块

kiwiairui · 发表于 2018-5-15 09:32:18

xdcad9819 · 发表于 2019-11-2 08:31:33

强大强大强大

账号		自动登录	找回密码
密码			立即注册

[文字] 删除重叠的相同文字

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评