Merry Christmas，I need help!
Christmas time is here. I hope you have a wonderful New Year. May every day hold happy hours for you.This code from http://www.cadtutor.net/forum/showthread.php?83657-I-need-overkill-and-ncopy-!please-help-me!by marko_ribar
(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- (equal (cadr x) (cadr lin) 1e-)) 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))))) ) (- (length linlsta) (length linlstn)))(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))
How to understand “0 lines”
There is another problem，Look at the following picture
I want Delete this short overlap too, Who help change it？ In your other thread about Express Tools, did you bother to read post #10?
Try this lisp routine.Load it and at the command line type ECONO.Pay attention to what is being asked on the command line.
econo3.lsp (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 online-p ( p1 p p2 ) (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-)(defun erasedupoverlin ( 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 (if (assoc 62 (entget lin)) (cdr (assoc 62 (entget lin))) nil) col420 (if (assoc 420 (entget lin)) (cdr (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 linlstn (if (vl-some '(lambda ( x ) (and (online-p (car x) (car lin) (cadr x)) (online-p (car x) (cadr lin) (cadr x)) (not (or (equal x lin 1e- (equal x (list (cadr lin) (car lin)) 1e-)))) linlstn) (setq linlstn (vl-remove lin linlstn)) ) ) (foreach lin linlsta (if (vl-some '(lambda ( x ) (and (equal (car x) (car lin) 1e- (equal (cadr x) (cadr lin) 1e-)) 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))))) ) (- (length linlsta) (length linlstn)))(defun c:eraseduplines-overlines-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 (erasedupoverlin s))(prompt " duplicate-lines erased") (prompt "\nTotal : ")(princ k)(prompt " zero-lines erased") (princ))(defun c:edo0l nil (c:eraseduplines-overlines-0lines))M.R.
"0 lines" are lines that have start/end point the same point...
Thank you !ReMark ,I do not know this lisp purpose, Function error。。。
ECONO Explode polylines before beginning? : y Join touching lines into
multi-segment polylines? : y
Starting to process drawing Drawing1.dwg on 12/25/1313:13:08
Please answer "yes" or "no."
; Error: Function is canceled
Thank you! marko_ribar,Is good! about "0 lines" ,I understand! The econo3.lsp works perfectly fine as I tested it with AutoCAD 2014.I also mentioned you had to pay attention to what was being asked on the command line.I don't know why it failed for you and worked for me.
I guess you never read my last post in your other thread (re: overkill and ncopy) regarding installing Express Tools.Correct?
页:
[1]