删除重复线LISP

chenbh2

(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))

ltrliu

新人学习中

胡杰45558

？？？？？？？？？？？？？？？

褪去的记忆

学习学习

菜鸟的萌

下来研究研究

773786668

马克学习！