[求助]求一个删除重线的LSp

kwok

有很多二条线或多线重迭在一起，求一个Lsp，一次过删除重迭的线。

sieben

(defun c:dl ()
  (setvar "cmdecho" 0)
  (setq ll (ssget))
  (setq llnum (sslength ll))
  (setq rep1 0)
  (repeat llnum
    (setq lname1 (ssname ll rep1)
   lent1  (entget lname1)
   lp11  (cdr (assoc '10 lent1))
   lp12  (cdr (assoc '11 lent1))
   lper1  (list lp11 lp12 lname1)
    )
    (setq rep2 0)
    (repeat llnum
      (setq lname2 (ssname ll rep2)
     lent2  (entget lname2)
     lp21   (cdr (assoc '10 lent2))
     lp22   (cdr (assoc '11 lent2))
     lper2  (list lp21 lp22 lname2)
      )
      (if (/= rep1 rep2)
 (progn
   (if (or (and (equal lp11 lp21) (equal lp12 lp22))
    (and (equal lp11 lp22) (equal lp12 lp21))
       )
     (vl-cmdf "erase" lname1 "")
   )
 )
      )
      (setq rep2 (1+ rep2))
    )
    (setq rep1 (1+ rep1))
    (princ (strcat "\rProcessing object " (itoa rep1) " of " (itoa llnum)))
  )
  (setvar "cmdecho" 1)
  (princ)
)

kwok

谢谢,

还有小提问,是不是要完全一模一样重迭的线才有用,

差点的好象就删不了?(就是线是重迭的,但两头的端点有点错位,)

sieben

是要完全一模一样

meflying

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10613

lijiao

给你一个链接

http://www.xdcad.net/forum/showthread.php?s=&threadid=220682&perpage=15&display=&pagenumber=1

kwok

就是没有一个可以删不重迭的线(就是线是重迭的,但两头的端点有点错位,)那位可以改改

Ea

如果使用 2006 用 Join 命令编程将简化很多，我写过一个和合并直线的程序，重迭或者有间隙的 Line 都可以合并。

cjs

用et的"overkill"试试

sdwy196912

程序不错