Leaderboard

(defun c:interpol ( / ss ssl index ent obj box ll ur lll url ss2 ss2l ) (vl-load-com) (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (progn (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (if (setq ss2 (ssget "CP" lll url '((0 . "LWPOLYLINE")))) (progn (setq ss2l (sslength ss2)) (if (> ss2l 1) (vlax-put-property obj 'color 2) ) ) (progn ) ) (setq index (+ index 1)) ) ) (progn) ) (princ) ) try this If you change (vlax-put-property obj 'color 2) to (vlax-put-property obj 'color (+ ss2l 1)) this will can change the color depending on the number of overlaps. but It may be difficult to recognize colors after 8 on the acad color index. it's gray. The one in this link is a more advanced method, but in your example the rectangle has an elevation value so strictly speaking straight lines are not intersecting with rectangles. so, you can trans or copy this rectangle to elevation 0 then use intersectwith, then delete that temporary rectangle is also possible approach. but ssget "CP" is more simple way.

(defun 1MT (break / *error* done e objlst obj wid str strllen strlist) ; <- add these 2 variable name ....................................................... (setq str (vla-get-TextString obj)) ; Insert these lines below this line. (setq strlist (list str)) (foreach x (cdr objlst) (setq str (vla-get-TextString x)) (setq strlist (cons str strlist)) ); foreach (setq strlist (vl-sort strlist '<)) (foreach x (cdr objlst) (vla-delete x) ) (setq str (car strlist)) (setq strlist (cdr strlist)) (setq strllen (length strlist)) (repeat strllen (setq str (strcat str break (car strlist))) (setq strlist (cdr strlist)) ) ; up to this line (vla-put-TextString obj str) This is a modification of 1MT. Just add these lines in defun 1MT. ================================================================================== or You can do this by creating a new command by adding the original, ascending sort, and descending sort options. first, Add 0 one by one to the original 3 commands and add sort, reverse sort commands ; original (defun C:1MT0 (); all in one paragraph -- 1 space between, no Enter (1MT " " 0); Space for 'break' argument in 1MT (princ) ) (defun C:1MT1 (); new paragraph for each object's content -- 1 Enter (1MT "\\P" 0); Enter for 'break' argument in 1MT (princ) ) (defun C:1MT2 (); blank line & new paragraph for each object's content -- 2 Enters (1MT "\\P\\P" 0); 2 Enters for 'break' argument in 1MT (princ) ) ; sort (Ascending) (defun C:1MTS0 () (1MT " " 1) (princ)) (defun C:1MTS1 () (1MT "\\P" 1) (princ)) (defun C:1MTS2 () (1MT "\\P\\P" 1) (princ)) ; reverse sort (descending) (defun C:1MTRS0 () (1MT " " 2) (princ)) (defun C:1MTRS1 () (1MT "\\P" 2) (princ)) (defun C:1MTRS2 () (1MT "\\P\\P" 2) (princ)) then, add sortoption to argument (defun 1MT (break sortoption / *error* done e objlst obj wid str strllen strlist) then modify the above code by adding (cond) like this. (setq str (vla-get-TextString obj)) ; Insert these lines below this line. (cond ((= sortoption 0) ) ((or (= sortoption 1) (= sortoption 2)) (setq strlist (list str)) (foreach x (cdr objlst) (setq str (vla-get-TextString x)) (setq strlist (cons str strlist)) ); foreach (cond ((= sortoption 1) (setq strlist (vl-sort strlist '<)) ) ((= sortoption 2) (setq strlist (vl-sort strlist '>)) ) ) (foreach x (cdr objlst) (vla-delete x) ) (setq str (car strlist)) (setq strlist (cdr strlist)) (setq strllen (length strlist)) (repeat strllen (setq str (strcat str break (car strlist))) (setq strlist (cdr strlist)) ) ) (t ) ) ; up to this line (vla-put-TextString obj str)

(defun c:interpol ( / acdoc *error* ss ssl index ent obj box ll ur lll url ss2 ss2l index2 ent2 obj2 elv2 interlist ) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark acdoc) (princ) ) (vla-StartUndoMark acdoc) (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (progn (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (if (setq ss2 (ssget "C" lll url '((0 . "LWPOLYLINE")))) (progn (setq ss2l (sslength ss2)) (if (> ss2l 1) (progn (setq index2 0) (repeat ss2l (setq ent2 (ssname ss2 index2)) (if (/= ent ent2) (progn (setq obj2 (vlax-ename->vla-object ent2)) (setq elv2 (vlax-get-property obj2 'elevation)) (if (/= elv2 0) (vlax-put-property obj2 'elevation 0) ) (setq interlist (vlax-invoke obj 'intersectwith obj2 acextendnone)) (if (> (length interlist) 2) (vlax-put-property obj 'color 2) ) (if (/= elv2 0) (vlax-put-property obj2 'elevation elv2) ) ) (progn) ) (setq index2 (+ index2 1)) ) ) (progn ) ; ) ) (progn ) ) (setq index (+ index 1)) ) ) (progn) ) (vla-EndUndoMark acdoc) (princ) ) this try When selecting a line with "cp", a straight line area was not selected. i don't know before that difference "cp" and "c" so I switched to "c". then filter that ss2 with intersectwith. I'm not sure if leakage occurs this way. But it worked in the example.

Yes, that would be better, I haven't had chance to think about this one today though. intersectwith should work, I'd have to confirm what it does with non-coplar elevations - can't remember everything!

Thanks I learned one more thing. yes as you told, the problem with this approach is that if the straight polyline is not straight but curved, "cp" may select unintended rectangular areas. So the perfect solution would be to change the elevation to 0 and then use intersect.

It's not polite post the same thing multiple places. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/chamfer-2-0/td-p/10822529