flyfox1047 发表于 2013-12-11 00:36:29

删除重复对象

本帖最后由 flyfox1047 于 2013-12-23 21:42 编辑



老外网上下的，带对话框，感觉还没ET的Overkill好用，源文件拿出来，想研究的拿去吧

再多上几个吧


再发删除重复线
(defun unique ( linlst )
(if (car linlst) (cons (car linlst) (unique (_vl-remove (car linlst) (_vl-remove (list (cadar linlst) (caar linlst)) (cdr linlst) 1e-6) 1e-6))))
)

(defun _vl-remove ( el lst fuzz )
(vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz))) lst)
)

(defun eraseduplin ( ss / i lin p1 p2 lay col62 col420 linlst linlsta linlstn )
(setq i -1)
(while (setq lin (ssname ss (setq i (1+ i))))
    (setq p1 (cdr (assoc 10 (entget lin)))
          p2 (cdr (assoc 11 (entget lin)))
          lay (cdr (assoc 8 (entget lin)))
          col62 (cdr (if (assoc 62 (entget lin)) (assoc 62 (entget lin)) nil))
          col420 (cdr (if (assoc 420 (entget lin)) (assoc 420 (entget lin)) nil))
    )
    (setq linlsta (cons (list p1 p2 lay col62 col420) linlsta))
    (setq linlst (cons (list p1 p2) linlst))
    (entdel lin)
)
(setq linlstn (unique linlst))
(foreach lin linlsta
    (if (vl-some '(lambda ( x ) (and (equal (car x) (car lin) 1e-8) (equal (cadr x) (cadr lin) 1e-8))) linlstn)
      (setq linlstn (subst lin (list (car lin) (cadr lin)) linlstn))
    )
)
(foreach lin linlstn
    (entmake (vl-remove nil (list '(0 . "LINE") (cons 8 (caddr lin)) (if (cadddr lin) (cons 62 (cadddr lin))) (if (caddr (cddr lin)) (cons 420 (caddr (cddr lin)))) (cons 10 (car lin)) (cons 11 (cadr lin)))))
)
)

(defun c:eraseduplines-0lines ( / ss s i k lin )
(setq ss (ssget "_:L" '((0 . "LINE"))))
(setq s (ssadd))
(setq i -1)
(setq k 0)
(while (setq lin (ssname ss (setq i (1+ i))))
    (if (equal (cdr (assoc 10 (entget lin))) (cdr (assoc 11 (entget lin))) 1e-4) (progn (setq k (1+ k)) (entdel lin)) (ssadd lin s))
)
(prompt "\nTotal : ")(princ (eraseduplin s))(prompt " duplicate-lines erased")
(prompt "\nTotal : ")(princ k)(prompt " zero-lines erased")
(princ)
)

(defun c:ed0l nil (c:eraseduplines-0lines))

jkop 发表于 2024-1-16 08:00:19

支持楼主！老外的程序也能试试参考，都多多益善。

479274135 发表于 2018-2-2 11:02:30

看帖回帖好习惯楼主辛苦

菜冬瓜 发表于 2024-1-13 11:37:02


楼主真是无私奉献啊！谢谢了！

sicky111 发表于 2013-12-11 21:14:10

这么多人下载，怎么都没见一个人支持楼主。

peraperson 发表于 2013-12-12 09:23:20

我来支持楼主

ysq101 发表于 2013-12-12 14:05:49

少人回复我相信是应该要验证码吧。。。。。

flyfox1047 发表于 2013-12-12 14:10:50

ysq101 发表于 2013-12-12 14:05 static/image/common/back.gif
少人回复我相信是应该要验证码吧。。。。。

LSP都是源码，又没编译，怎会要验证码？

edata 发表于 2013-12-12 21:29:43

flyfox1047 发表于 2013-12-12 14:10 static/image/common/back.gif
LSP都是源码，又没编译，怎会要验证码？

四楼只的是 回帖需要验证码。。现在貌似没有验证码了。

xujinhua 发表于 2013-12-13 09:05:10

楼主顶你...这么多好东东

haoryh 发表于 2013-12-13 09:14:53

路过也顶一下！

mycad 发表于 2013-12-13 13:21:32

谢谢！！！！！！！！！

混沌初开 发表于 2013-12-13 18:48:34

支持楼主!
页: [1] 2 3 4 5 6 7 8 9
查看完整版本: 删除重复对象