gao6690 发表于 2008-3-11 10:01:00

[原创]删重复：线，点，文本，块

<p>(princ "\n命令：scf")<br/>(defun c:scf ()<br/>&nbsp; (sfff "lwpolyline")<br/>&nbsp; (sfff "line")<br/>&nbsp; (sfff "point")<br/>&nbsp; (sfff "text")<br/>&nbsp; (sfff "insert")</p><p>)<br/>(defun sfff (ffff)<br/>&nbsp; (setvar "cmdecho" 0)<br/>&nbsp; (setvar "osmode" 0)<br/>&nbsp; (command "convertpoly" "l" "all" "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp; (setq aa (ssget "x" (list (cons 0 ffff))))<br/>&nbsp; (if aa<br/>&nbsp;&nbsp;&nbsp; (progn</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq len1 (sslength aa)<br/>&nbsp;&nbsp;&nbsp;&nbsp; n&nbsp; 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (repeat len1<br/>&nbsp;(setq aa1 (ssname aa n))<br/>&nbsp;(setq n (+ n 1))<br/>&nbsp;(setq bb (entget aa1 '("*")))<br/>&nbsp;(setq zb1 (cdr (assoc 10 bb)))<br/>&nbsp;(setq tc (cdr (assoc 8 bb)))<br/>&nbsp;(setq jb1 (cdr (assoc 5 bb)))<br/>&nbsp;(setq w100 (assoc 100 bb))<br/>&nbsp;(setq w101 (member w100 bb))</p><p>&nbsp;(setq px1 (car zb1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; py1 (cadr zb1)<br/>&nbsp;)<br/>&nbsp;(setq px2 (- px1 5)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; px3 (+ px1 5)<br/>&nbsp;)<br/>&nbsp;(setq py2 (- py1 5)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; py3 (+ py1 5)<br/>&nbsp;)<br/>&nbsp;(setq pn2 (list px2 py2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pn3 (list px3 py3)<br/>&nbsp;)<br/>&nbsp;(command "zoom" "c" pn2 20)<br/>&nbsp;(setq ls-s (ssget "c" pn2 pn3 (list (cons 0 ffff) (cons 8 tc))))<br/>&nbsp;(if ls-s<br/>&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq lens (sslength ls-s)<br/>&nbsp;&nbsp;&nbsp; ns&nbsp;&nbsp; 0<br/>&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp; (if&nbsp;(&gt; lens 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;(repeat&nbsp;lens<br/>&nbsp;&nbsp;&nbsp; (setq aas (ssname ls-s ns))<br/>&nbsp;&nbsp;&nbsp; (setq ns (+ ns 1))<br/>&nbsp;&nbsp;&nbsp; (setq wbb (entget aas '("*")))<br/>&nbsp;&nbsp;&nbsp; (setq jb2 (cdr (assoc 5 wbb)))<br/>&nbsp;&nbsp;&nbsp; (setq ww100 (assoc 100 wbb))<br/>&nbsp;&nbsp;&nbsp; (setq ww101 (member ww100 wbb))<br/>&nbsp;&nbsp;&nbsp; (if (/= jb1 jb2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (= (equal w101 ww101) t)<br/>&nbsp;&nbsp;&nbsp;(command "erase" aa1 "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )</p><p>&nbsp;&nbsp;&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;&nbsp;;if (&gt; lens 1)<br/>&nbsp;&nbsp; )<br/>&nbsp;)&nbsp;&nbsp;&nbsp;&nbsp;;if ls-s</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;repeat len1<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>&nbsp; (command "convertpoly" "h" "all" "")</p><p>)</p>

tzan8752 发表于 2011-6-28 19:59:39

我正好 要这个程序非常感谢

429014673 发表于 2011-6-29 09:59:05

回复 gao6690 的帖子

能框选最好了

zhaozwf 发表于 2011-7-25 14:51:31

删除不掉重线，效果不好
页: [1]
查看完整版本: [原创]删重复：线，点，文本，块