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

gao6690

(princ "\n命令：scf")
(defun c:scf ()
  (sfff "lwpolyline")
  (sfff "line")
  (sfff "point")
  (sfff "text")
  (sfff "insert")

)
(defun sfff (ffff)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (command "convertpoly" "l" "all" "")
     
  (setq aa (ssget "x" (list (cons 0 ffff))))
  (if aa
    (progn

      (setq len1 (sslength aa)
     n  0
      )
      (repeat len1
 (setq aa1 (ssname aa n))
 (setq n (+ n 1))
 (setq bb (entget aa1 '("*")))
 (setq zb1 (cdr (assoc 10 bb)))
 (setq tc (cdr (assoc 8 bb)))
 (setq jb1 (cdr (assoc 5 bb)))
 (setq w100 (assoc 100 bb))
 (setq w101 (member w100 bb))

 (setq px1 (car zb1)
       py1 (cadr zb1)
 )
 (setq px2 (- px1 5)
       px3 (+ px1 5)
 )
 (setq py2 (- py1 5)
       py3 (+ py1 5)
 )
 (setq pn2 (list px2 py2)
       pn3 (list px3 py3)
 )
 (command "zoom" "c" pn2 20)
 (setq ls-s (ssget "c" pn2 pn3 (list (cons 0 ffff) (cons 8 tc))))
 (if ls-s
   (progn
     (setq lens (sslength ls-s)
    ns   0
     )
     (if (> lens 1)
       (progn
  (repeat lens
    (setq aas (ssname ls-s ns))
    (setq ns (+ ns 1))
    (setq wbb (entget aas '("*")))
    (setq jb2 (cdr (assoc 5 wbb)))
    (setq ww100 (assoc 100 wbb))
    (setq ww101 (member ww100 wbb))
    (if (/= jb1 jb2)
      (progn
        (if (= (equal w101 ww101) t)
   (command "erase" aa1 "")
        )
      )
    )
  )

       )

     )    ;if (> lens 1)
   )
 )    ;if ls-s

      )     ;repeat len1
    )
  )
  (command "convertpoly" "h" "all" "")

)

tzan8752

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

429014673

回复 gao6690 的帖子

能框选最好了

zhaozwf

删除不掉重线，效果不好