Merry Christmas，I need help!

lucas3 · 发表于 2022-7-5 23:49:06

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

copy

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

ReMark · 发表于 2022-7-6 00:09:18

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

marko_ribar · 发表于 2022-7-6 00:20:01

copy

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

lucas3 · 发表于 2022-7-6 00:25:59

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/13 13:13:08
Please answer "yes" or "no."
; Error: Function is canceled

lucas3 · 发表于 2022-7-6 00:38:59

Thank you! marko_ribar,Is good! about "0 lines" ,I understand!

ReMark · 发表于 2022-7-6 00:57:57

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?

[编程交流] Merry Christmas，I need help!

发表回复

精选推荐