Lisp to change color of intersecting polylines

[noyajr]

I have some bunch of polylines in my drawing, some times these polylines intersect. I want to select all of the polylines and if the polylines intersect then the intersecting polylines color to be changed to yellow (or any color)

 

Does anyone have a lisp to do that ?

new block.dwg

[exceed]

 

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

 

Edited September 18, 2023 by exceed

[noyajr]

2 hours ago, exceed said:

 

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

 

It worked very well. Thank you so much

 

[Steven P]

I was getting a slight error with the ssget 'cp', in AutoCAD needing the 4 corners of a bounding box, and not the 2 opposing corners:

 

(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

(setq lrl (list (car url) (cadr lll)))
(setq ull (list (car lll) (cadr url)))

        (if (setq ss2 (ssget "CP" (list lll lrl url ull) '((0 . "LWPOLYLINE"))))

;        (if (setq ss2 (ssget "CP" (list 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)
)

 

 

 

Also, a slight issue might come up if a polyline is near another, they don't cross but are within each others bounding box. I think it needs a check after the 2nd selection set something with a vla-intersectqith perhaps? I like having the 2nd selection set, speeds things up if there are a lot of polylines to assess,

[exceed]

20 minutes ago, Steven P said:

I was getting a slight error with the ssget 'cp', in AutoCAD needing the 4 corners of a bounding box, and not the 2 opposing corners:

 

(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

(setq lrl (list (car url) (cadr lll)))
(setq ull (list (car lll) (cadr url)))

        (if (setq ss2 (ssget "CP" (list lll lrl url ull) '((0 . "LWPOLYLINE"))))

;        (if (setq ss2 (ssget "CP" (list 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)
)

 

 

 

Also, a slight issue might come up if a polyline is near another, they don't cross but are within each others bounding box. I think it needs a check after the 2nd selection set something with a vla-intersectqith perhaps? I like having the 2nd selection set, speeds things up if there are a lot of polylines to assess,

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.

Edited September 18, 2023 by exceed

[Steven P]

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!

 

Edited September 18, 2023 by Steven P

[exceed]

 

 

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