LISP that selects all overlaping lines

[masterfal]

99% of the time i'm tidying up clients drawings to use with our drawings so i'm not actually drawing any of these windows

 

can anyone explain why overkill isn't removing all my overlapping lines though? its supposed to yeh? does overkill actually just not work properly? or does it work correctly, only removing exact duplicate lines?

[masterfal]

20 hours ago, marko_ribar said:

Maybe, and just maybe, my version can help...

You must be logged to access web page...

Here is the link : https://www.theswamp.org/index.php?topic=49862.0

HTH.

M.R.

i tried this out. it removed the duplicates from 3 of the 4 windows. don't understand why it wouldn't remove duplicates from that last window though..

[CADSURAY]

I Call it the OVERKILL Finder

 

(defun c:OVERFIND (/ i namess ss1)
 (setq ss1 (ssget "_X"))
 (command "_.undo" "_M" ".-overkill" "_All" ""	"_I" "_ALL" "" "")
 (setq ss (ssget "_X"))
 (command "_.undo" "_B")
 (repeat (setq i (sslength ss))
   (if	(ssmemb (setq name (ssname ss (setq i (1- i)))) ss1)
     (ssdel name ss1)
   )
 );; repeat
 (if ss1
   (sssetfirst nil ss1)
 );; if
 (princ)
)

 

[CADSURAY]

i Might have found this on CADTUTOR only.

[Anders M]

On 2/14/2025 at 11:03 AM, CADSURAY said:

I Call it the OVERKILL Finder

Hello!
Your Lisp finds all polylines that overlaps and selects them, but it only selecs one of the overlapping ones.
That is a very good start, but I'd like it to select both overlaps, so I easily can delete them all.

 

 

[Steven P]

Are you able to post a sample drawing, or a snippet of a drawing?

 

This is a bit slow but might work - probably for a large drawing a grab a coffee while it runs speed.

 

 

(defun c:test ( / MySS acount acounter DelSS MyLine NextLine MyEndA MyEndB NextEndA NextEndB)
  (setq MySS (ssget '((0 . "LINE")))) ;; Select all lines
  (setq DelSS (ssadd))                ;; Blank selection set
  (setq acount 0)                     ;; A counter
  (while (< (+ acount 1) (sslength MySS)) ;; A loop the length of selection less 1
    (setq MyLine (ssname MySS acount)) ;; Line to assess (works through full selection set)
    (setq MyEndA (cdr (assoc 10 (entget MyLine)))) ;; Assessed line end points
    (setq MyEndB (cdr (assoc 11 (entget MyLine))))
    (setq acounter (+ acount 1))
    (while (< acounter (sslength MySS))  ;; Compare est of selecton set
      (setq NextLine (ssname MySS acounter)) ;; A line to compare with
      (setq NextEndA (cdr (assoc 10 (entget NextLine)))) ;; Comparison line end points
      (setq NextEndB (cdr (assoc 11 (entget NextLine))))

      (if (and ;; If lines line up
          (or
            (equal MyEndA NextEndA)
            (equal MyEndA NextEndB)
          ) ; endor
          (or
            (equal MyEndB NextEndA)
            (equal MyEndB NextEndB)
          ) ; endor
        ) ; end And
        (progn
          (setq DelSS (ssadd MyLine DelSS)) ;; Add MyLine to deletion selection set
          (setq DelSS (ssadd NextLine DelSS)) ;; Add next line to deletion selection set. Ignore one to only delete 1 line
        ) ; end progn
        (progn ;; if lines don't line up... do nothing
        ) ; end progn
      ) ; end if

      (setq acounter (+ acounter 1))
    ) ; end while acounter
    (setq acount (+ acount 1))
  ) ; end while acount

  (command "erase" DelSS "")
  (princ)
)

 

 

If it was me I'd be checking this by commenting out the delete line and adding in a line to either move to separate layers or colour the lines. Limited testing but appears to work.

 

If you want you can add in a fuzz factor for the equals statements. This will only select lines where the end match - if they are aligned with different start / end points they are passed by. No checking for line types, layers, colours.....

Edited Tuesday at 07:57 PM by Steven P

[Danielm103]

Try this one

Arx25speedDupl.zip

[masterfal]

On 2/19/2025 at 3:54 AM, Steven P said:

Are you able to post a sample drawing, or a snippet of a drawing?

 

This is a bit slow but might work - probably for a large drawing a grab a coffee while it runs speed.

 

 

(defun c:test ( / MySS acount acounter DelSS MyLine NextLine MyEndA MyEndB NextEndA NextEndB)
  (setq MySS (ssget '((0 . "LINE")))) ;; Select all lines
  (setq DelSS (ssadd))                ;; Blank selection set
  (setq acount 0)                     ;; A counter
  (while (< (+ acount 1) (sslength MySS)) ;; A loop the length of selection less 1
    (setq MyLine (ssname MySS acount)) ;; Line to assess (works through full selection set)
    (setq MyEndA (cdr (assoc 10 (entget MyLine)))) ;; Assessed line end points
    (setq MyEndB (cdr (assoc 11 (entget MyLine))))
    (setq acounter (+ acount 1))
    (while (< acounter (sslength MySS))  ;; Compare est of selecton set
      (setq NextLine (ssname MySS acounter)) ;; A line to compare with
      (setq NextEndA (cdr (assoc 10 (entget NextLine)))) ;; Comparison line end points
      (setq NextEndB (cdr (assoc 11 (entget NextLine))))

      (if (and ;; If lines line up
          (or
            (equal MyEndA NextEndA)
            (equal MyEndA NextEndB)
          ) ; endor
          (or
            (equal MyEndB NextEndA)
            (equal MyEndB NextEndB)
          ) ; endor
        ) ; end And
        (progn
          (setq DelSS (ssadd MyLine DelSS)) ;; Add MyLine to deletion selection set
          (setq DelSS (ssadd NextLine DelSS)) ;; Add next line to deletion selection set. Ignore one to only delete 1 line
        ) ; end progn
        (progn ;; if lines don't line up... do nothing
        ) ; end progn
      ) ; end if

      (setq acounter (+ acounter 1))
    ) ; end while acounter
    (setq acount (+ acount 1))
  ) ; end while acount

  (command "erase" DelSS "")
  (princ)
)

 

 

If it was me I'd be checking this by commenting out the delete line and adding in a line to either move to separate layers or colour the lines. Limited testing but appears to work.

 

If you want you can add in a fuzz factor for the equals statements. This will only select lines where the end match - if they are aligned with different start / end points they are passed by. No checking for line types, layers, colours.....

 

i ran it on this tiny drawing and didnt seem to work properly..

 

OVERLAPPING LINES.dwg

[Steven P]

Edited code below. This will remove BOTH duplicated lines according to the OPs question - the problem being before that the overlapping lines were not exact duplicates. Added in a fuzz factor in the "equal" statements of 0.01 to grab these. It might be that the OP needs a much smaller or larger fuzz factor (which is why them supplying a sample drawing is handy).

 

For Masterfall, yes, Overkill will only work on exact duplicates - you can kind of do the same below with keeping 1 line, delete the other by commenting out one of the lines for example "(setq DelSS (ssadd MyLine DelSS))"

 

 

 

(defun c:test ( / MySS acount acounter DelSS MyLine NextLine MyEndA MyEndB NextEndA NextEndB)
  (setq MySS (ssget '((0 . "LINE")))) ;; Select all lines
  (setq DelSS (ssadd))                ;; Blank selection set
  (setq acount 0)                     ;; A counter
  (while (< (+ acount 1) (sslength MySS)) ;; A loop the length of selection less 1
    (setq MyLine (ssname MySS acount)) ;; Line to assess (works through full selection set)
    (setq MyEndA (cdr (assoc 10 (entget MyLine)))) ;; Assessed line end points
    (setq MyEndB (cdr (assoc 11 (entget MyLine))))
    (setq acounter (+ acount 1))
    (while (< acounter (sslength MySS))  ;; Compare est of selecton set
      (setq NextLine (ssname MySS acounter)) ;; A line to compare with
      (setq NextEndA (cdr (assoc 10 (entget NextLine)))) ;; Comparison line end points
      (setq NextEndB (cdr (assoc 11 (entget NextLine))))

      (if (and ;; If lines line up
          (or
            (equal MyEndA NextEndA 0.01)
            (equal MyEndA NextEndB 0.01)
          ) ; endor
          (or
            (equal MyEndB NextEndA 0.01)
            (equal MyEndB NextEndB 0.01)
          ) ; endor
        ) ; end And
        (progn
          (setq DelSS (ssadd MyLine DelSS)) ;; Add MyLine to deletion selection set
          (setq DelSS (ssadd NextLine DelSS)) ;; Add next line to deletion selection set. Ignore one to only delete 1 line
        ) ; end progn
        (progn ;; if lines don't line up... do nothing
        ) ; end progn
      ) ; end if

      (setq acounter (+ acounter 1))
    ) ; end while acounter
    (setq acount (+ acount 1))
  ) ; end while acount

  (command "erase" DelSS "")
  (princ)
)

 

[CADSURAY]

On 2/18/2025 at 6:38 PM, Anders M said:

Hello!
Your Lisp finds all polylines that overlaps and selects them, but it only selecs one of the overlapping ones.
That is a very good start, but I'd like it to select both overlaps, so I easily can delete them all

 

This Must Do It...

(defun c:OVERKILLSELECT (/ ss1 ent1 ent2 lst1 lst2 overlap obj selset)
  (setq ss1 (ssget "_X" '((0 . "LINE,LWPOLYLINE,POLYLINE,ARC")))) ; Select all lines, polylines, arcs globally
  (if ss1
    (progn
      (setq lst1 (vl-remove-if 'null (mapcar 'entget (vl-remove-if 'null (mapcar 'cadr (ssnamex ss1)))))) ; Get entity data
      (setq lst2 lst1) ; Duplicate list for comparison
      (setq overlap nil)
      (foreach ent1 lst1
        (foreach ent2 lst2
          (if (and (not (eq ent1 ent2)) ; Ensure different objects
                   (equal (cdr (assoc 10 ent1)) (cdr (assoc 10 ent2)) 0.001) ; Compare start points
                   (equal (cdr (assoc 11 ent1)) (cdr (assoc 11 ent2)) 0.001)) ; Compare end points
            (progn
              (setq overlap (cons (cdr (assoc -1 ent1)) overlap)) ; Store overlapping entities
            )
          )
        )
      )
      (if overlap
        (progn
          (setq selset (ssadd)) ; Create empty selection set
          (foreach obj overlap
            (ssadd obj selset) ; Add overlapping objects to selection set
          )
          (sssetfirst nil selset) ; Highlight selected objects
          (princ (strcat "\nTotal overlapping objects selected: " (itoa (length overlap))))
        )
        (princ "\nNo overlapping objects detected.")
      )
    )
    (princ "\nNo objects found to check.")
  )
  (princ)
)

 

[CADSURAY]

Also Extended it to work with...Lines, Polylines and ARCs

[Steven P]

Not quite with polylines... It thinks all of the below are overlapping... you're just checking the end points and not all the points along the polyline

 

(polylines are tricky, if you want exact then use massoc LISP to return a list of points for the 2 lines, compare the number of points and if equal use member for each point on the reference line to check it is in the compared line.... trickier again when overlapping polyline segments might have different intermediate points for the same shape)

 

 

[Danielm103]

Then there's polyline bulges

CurveCurveInt3d seems to correctly identify bulges that overlap

 

import traceback
from pyrx import Rx, Ge, Gi, Db, Ap, Ed, Ax

@Ap.Command()
def doit():
    try:
        filter = [(Db.DxfCode.kDxfStart, "*LINE")]
        ps, ss = Ed.Editor.selectPrompt("Add lines: ", "Remove lines: ", filter)
        if ps != Ed.PromptStatus.eOk:
            raise RuntimeError("Selection Error! {}: ".format(ps))
        curves = [Db.Curve(id) for id in ss.objectIds()]
        for crv1 in curves:
            for crv2 in curves:
                if crv1 == crv2:
                    continue
                gec1 = crv1.getAcGeCurve()
                gec2 = crv2.getAcGeCurve()
                cci = Ge.CurveCurveInt3d(gec1, gec2)
                for idx in range(cci.overlapCount()):
                    iv1, iv2 = cci.getOverlapRanges(idx)
                    Ed.Core.grDrawCircle(crv1.getPointAtDist(iv1.lowerBound()),1,20,1)
                    Ed.Core.grDrawCircle(crv1.getPointAtDist(iv1.upperBound()),1,20,1)
    except Exception as err:
        traceback.print_exception(err)

Edited yesterday at 01:36 PM by Danielm103

[CADSURAY]

I Just Extended to select the Overlapping Lines, Polylines, Closed Polylines & Arcs.

i Dont See a Problem with the same. it is working Perfectly. and what i understood from the OP's Requirement.

 

Attached Sample Drawing 

 

(defun c:OVERKILLSELECT (/ ss1 ent1 ent2 lst1 lst2 overlap obj selset)
  (setq ss1 (ssget "_X" '((0 . "LINE,LWPOLYLINE,POLYLINE,ARC")))) ; Select all lines, polylines, arcs globally
  (if ss1
    (progn
      (setq lst1 (vl-remove-if 'null (mapcar 'entget (vl-remove-if 'null (mapcar 'cadr (ssnamex ss1)))))) ; Get entity data
      (setq lst2 lst1) ; Duplicate list for comparison
      (setq overlap nil)
      (foreach ent1 lst1
        (foreach ent2 lst2
          (if (and (not (eq ent1 ent2)) ; Ensure different objects
                   (equal (cdr (assoc 10 ent1)) (cdr (assoc 10 ent2)) 0.001) ; Compare start points
                   (equal (cdr (assoc 11 ent1)) (cdr (assoc 11 ent2)) 0.001)) ; Compare end points
            (progn
              (setq overlap (cons (cdr (assoc -1 ent1)) overlap)) ; Store overlapping entities
            )
          )
        )
      )
      (if overlap
        (progn
          (setq selset (ssadd)) ; Create empty selection set
          (foreach obj overlap
            (ssadd obj selset) ; Add overlapping objects to selection set
          )
          (sssetfirst nil selset) ; Highlight selected objects
          (princ (strcat "\nTotal overlapping objects selected: " (itoa (length overlap))))
        )
        (princ "\nNo overlapping objects detected.")
      )
    )
    (princ "\nNo objects found to check.")
  )
  (princ)
)

 

 

Overkill Select.dwg

[GLAVCVS]

Maybe it's just a matter of adding a function that filters out the polylines selected by the current code.

[Danielm103]

@CADSURAY try this drawing

 

 

curve.dwg

[GLAVCVS]

1 hour ago, GLAVCVS said:

Tal vez sea solo cuestión de agregar una función que filtre las polilíneas seleccionadas por el código actual.

 

@CADSURAY

But no.
I've taken a look at your code and I see things that are not right.
You apply a single filter for lines, polylines and arcs:
the match in codes 10 and 11.
But that match can only occur in lines, because neither polylines nor arcs use code 11.

Your code works 'apparently' when it is true that code 10 matches between 2 objects. And code 11, in any entity that is not a line, will always match, because it will always be 'nil'. That is, code 11 of a polyline, an arc, a 'leader', a 'hatch'... etc. will always match.
As for code 10, in arc objects it will always match when the center is the same, even if they do not overlap.
In polylines, it will also match when only the first point of the polyline matches, even if no other points match.

Conclusion: your code only works well with LINE objects.

Edited 4 hours ago by GLAVCVS

[CADSURAY]

1 hour ago, Danielm103 said:

@CADSURAY try this drawing

 

 

curve.dwg 31.42 kB · 2 downloads

 

i see what you were pointing at Danielm103....

the best i think is to mark the overlapping portions with points for now whit this code...

Trying to Trace the Path of the Overlaping portion with a new polyline would be more like it...

 

(defun c:MarkOverlap (/ ss plines layerName overlapLayer pline1 pline2 intPoints ptCount pt)
  ;; Prompt user to select polylines
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if (not ss)
    (progn
      (alert "No polylines selected. Exiting.")
      (exit)
    )
  )

  ;; Debugging: Print the number of polylines selected
  (princ (strcat "\nNumber of polylines selected: " (itoa (sslength ss))))

  ;; Create a new layer for overlap points
  (setq layerName "OverlapPoints")
  (setq overlapLayer (tblsearch "LAYER" layerName))
  (if (not overlapLayer)
    (progn
      (command "._-LAYER" "_M" layerName "_C" "1" layerName "")
      (princ (strcat "\nNew layer created: " layerName))
    )
    (princ (strcat "\nLayer already exists: " layerName))
  )

  ;; Set the new layer as current
  (setvar "CLAYER" layerName)
  (princ (strcat "\nCurrent layer set to: " layerName))

  ;; Convert selection set to a list of polylines
  (setq plines '())
  (setq index 0)
  (repeat (sslength ss)
    (setq pline (ssname ss index))
    (setq plines (cons pline plines))
    (setq index (1+ index))
  )
  (setq plines (reverse plines)) ;; Reverse to maintain original order
  (princ (strcat "\nNumber of polylines processed: " (itoa (length plines))))

  ;; Initialize point counter
  (setq ptCount 0)

  ;; Iterate through all pairs of polylines
  (foreach pline1 plines
    (foreach pline2 plines
      (if (not (eq pline1 pline2))
        (progn
          ;; Debugging: Print the handles of the polylines being compared
          (princ (strcat "\nComparing polyline 1 (Handle: " (vlax-get (vlax-ename->vla-object pline1) 'Handle) ")"))
          (princ (strcat "\nComparing polyline 2 (Handle: " (vlax-get (vlax-ename->vla-object pline2) 'Handle) ")"))

          ;; Find intersection points
          (setq intPoints (vlax-invoke (vlax-ename->vla-object pline1) 'IntersectWith (vlax-ename->vla-object pline2) acExtendNone))
          (if intPoints
            (progn
              ;; Debugging: Print the number of intersection points found
              (princ (strcat "\nIntersection points found: " (itoa (/ (length intPoints) 3))))

              ;; Process intersection points
              (setq i 0)
              (while (< i (length intPoints))
                (setq pt (list (nth i intPoints) (nth (1+ i) intPoints) (nth (+ 2 i) intPoints)))
                (command "._POINT" pt)
                (setq ptCount (1+ ptCount)) ;; Increment point counter
                (setq i (+ i 3)) ;; Move to the next set of coordinates
              )
            )
            (princ "\nNo intersection points found.")
          )
        )
      )
    )
  )

  ;; Debugging: Print the total number of points created
  (princ (strcat "\nTotal points created: " (itoa ptCount)))

  ;; Reset to the previous layer
  (setvar "CLAYER" (getvar "CLAYER"))
  (princ "\nOverlap locations marked with points on layer 'OverlapPoints'.")
  (princ)
)

 curve.dwg

[Steven P]

CadSuray, the above are constructive comments by the way, not criticism (I know you won't take them as such... but some internet forums are full of prima-donnas, this one isn't).

 

Take them as the forum are quite happy to help you out with this one, this could turn out to be a useful LISP for many.

 

 

Working through, I think after you have selected all entities you might want a condition or if statement to look at each entity type in turn - there is no single solution for all.

 

Lines are working OK

Circles are the next easiest to look at requiring insert point (assoc code 10) and radius (code 40) - the same program as lines just change '11' to '40'

Arcs you will want to consider 10, 40, 50 and 51

Text is the next level of tricky

and polylines.. they are going to take a bit more thinking!

 

As Glavcvs suggests for lines, circles, arcs you could probably consider all the codes, 10, 11, 40, 50 and 51 - if it isn't used for that entity it will be 'nil' and therefore equal to nil for others of the same type. I'd go to make the easy parts working first and we can guide you for the polylines and texts

[Steven P]

If you want to jump straight to polylines:

 

(outside of code tags, just ideas here)

MyLine : Polyline entity name

Startpoint (assoc 10 MyLine)

End P0oint (assoc 10 (reverse MyLine))

If start and end points are the same go further (quick test to speed up the processing)

  PointsList (Massoc MyLine 10) : Massoc from an internet search, I generally use Lee Macs version

  If points list for both lines are the same list length

    (if member (nth point MyLine1) (PointsList - MyLine2): matching point

If all points match (use equals + fuzz factor) do the same for 40? bulges

then you are getting closer.

 

Have fun!!

Edited 3 hours ago by Steven P