Leaderboard

I modify a little, because i find a problem when all lines ar duplicated. This is the new. ;Create from Georgi Georgiev - TRUDY ;Date 11.10.2020 (defun c:try1 ( / A BR BRR DELLST EMPLAY ENT I LAY LAY2 LI LIL LIST3 LIST4 LIST5 LISTT LISTT2 N NAM PT_LINE SEL1 SEL2 SEL3 SS) (vl-load-com) (setvar "osmode" 0) ;(setq listt nil) (setq listt2 nil) (setq list3 nil) (setq list4 nil) (setq lay nil) (setq lay2 nil) (setq br '()) (setq emplay nil) (setq dellst nil) (setq lil nil) (Princ (strcat "\r Select lines ")) ;select lines,layers ;move to new layer (setq sel1 (ssget '((0 . "line")))) (repeat (setq i (sslength sel1)) (setq nam (ssname sel1 (setq i (1- i)))) (setq ent (entget nam)) (setq listt (cons (cdr (assoc 11 ent)) listt)) (setq listt2 (cons (cdr (assoc 10 ent)) listt2)) ;(setq lay (assoc 8 ent)) (setq lay2 (subst (cons 8 (strcat "Trudy_" (cdr (assoc 8 ent)))) (assoc 8 ent) ent)) (entmod lay2) ) (setq list3 (append listt listt2)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;remove duplicated points (while list3 (setq list4 (cons (car list3) list4)) (setq list3 (vl-remove (car list3) list3)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;select all in new Trudy_ layer ;max needed repeat (setq sel2 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>")))) (repeat (setq i (sslength sel2)) (setq list5 list4) (setq nam (ssname sel2 (setq i (1- i)))) (setq n 0) (repeat (length list5) (setq pt_line (vlax-curve-getclosestpointto nam (car list5) t)) (if (equal pt_line (car list5) 0.00001) (progn (setq n (+ n 1)) (setq br (cons n br)) ) (princ) ) (setq list5 (cdr list5)) ) ) (setq br (vl-sort br '>)) (princ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;select all in new Trudy_ layer ;repeat times and break (repeat (- (car br) 2) (setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>")))) (repeat (setq i (sslength sel3)) (setq list5 list4) (setq nam (ssname sel3 (setq i (1- i)))) (repeat (length list5) (setq pt_line (vlax-curve-getclosestpointto nam (car list5) t)) (if (equal pt_line (car list5) 0.0001) (command "BREAK" nam (car list5) "@") (princ)) (setq list5 (cdr list5)) (princ "\rBREAKING... \r") ) ) ) (princ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;select all in new Trudy_ layer ;move to duplicate layer (if (setq ss (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>")))) (progn (repeat (setq i (sslength ss)) (setq li (ssname ss (setq i (1- i)))) (setq lil (cons (list (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li))) li) lil)) ) (foreach li lil (if (vl-some '(lambda ( x ) (or (and (equal (car li) (car x) 1e-6) (equal (cadr li) (cadr x) 1e-6)) (and (equal (car li) (cadr x) 1e-6) (equal (cadr li) (car x) 1e-6)))) (vl-remove li lil)) (setq dellst (cons (caddr li) dellst)) ) ) ) ) (setq brr (length dellst)) (princ brr) (repeat (length dellst) ;(setq nam (ssname ss (setq i (1- i)))) (setq ent (entget (car dellst))) ;(princ ent) (setq lay2 (subst (cons 8 (strcat "duplicate_lines" )) (assoc 8 ent) ent)) (entmod lay2) (setq dellst (cdr dellst)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;select all in new Trudy_ layer ;move all to old layer (setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>")))) (if sel3 (repeat (setq i (sslength sel3)) (setq nam (ssname sel3 (setq i (1- i)))) (setq ent (entget nam)) (setq lay2 (subst (cons 8 (substr (cdr (assoc 8 ent)) 7)) (assoc 8 ent) ent)) (entmod lay2) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;delete all Trudy_ layers (while (setq a (tblnext "LAYER" (null a))) (setq emplay (cons (cdr (assoc 2 a)) emplay)) ) ;(princ emplay) (foreach y emplay (if (wcmatch y "Trudy_*") (command "laydel" "N" y "" "Y"))) (princ (strcat "\n" "Select" " " (rtos (sslength sel1) 2 0) " " "lines")) (princ (strcat "\n" "Found" " " (rtos (length list4) 2 0) " " "non duplicate points")) (princ (strcat "\n" "Repeat" " " "breaking" " " (rtos (- (car br) 2) 2 0) " " "times")) (if sel3 (princ (strcat "\n" "Result" " " "is" " " (rtos (sslength sel3) 2 0) " " "new lines")) (princ "\nall lines are duplicate")) (princ (strcat "\n" "Duplicate lines are" " " (rtos (/ brr 2) 2 0))) (princ) )

They can be combined. So there are about 33^32 combinations for keeping your mind stuck in Revit. Rev' that..

AutoCAD LT on a subscription?? Really. I might as well trow money out of the window. The signs say: Move away from Autodesk. I use GstarCAD now 600,- euro forever. Completely AutoCAD , no difference Most lisp and addon work fine.