Select the overlaping objects

[kite15]

Hi,

Mainly, we are deleting duplicate objects by using "OVERKILL" command and selecting overlapping objects by using "selection cycling".

But, we need to select only the Overlapping objects.

After searching, I was seen a lisp code its can provide option to find and delete (http://www.afralisp.net/archive/Tips/code9.htm).

It's closer as per our requirements, actually the requirement is that we need only select the overlapping objects by changing its color to red (1).

Plese help!!      Thanks in advance!!

[ВeekeeCZ]

Have you tried to contact the author?
Btw you should sort your requirements...
- this routine prompts the user to confirm each overlapping ent one by one - that's ok?
- you need to select overlapping objects or change their color to red or both?

[kite15]

Needs!!:

Select only overlapping objects from a selection set. No need to select objects one by one.

Example: If the B (Back) Line under the line F (Front), then only the F line will be select and send it to another color.

Q: Have you tried to contact the author?

A: No

Q: this routine prompts the user to confirm each overlapping ent one by one - that's ok?

A: Prompt to select as per needs (Window) but, not one by one.

Q: you need to select overlapping objects or change their color to red or both?

A: Atleast change only the overlapped object color, whereas the another (Duplicate) remain as previous properties.

[ВeekeeCZ]

Ok then, try the code. Objects are colored in red and highlighted without prompts for user. No selection made.

Spoiler

; original: sanganaksakha@freelance-worker.com
; http://www.afralisp.net/archive/Tips/code9.htm

; Modification by BeekeeCZ 2016/1
; Multiply change of color of overlapping objects

(vl-load-com)

;;; ======================
(defun c:Overlap ()
  (setq oOSMODE (getvar "OSMODE"))
  (Setvar "OSMODE" 0)
  (setq oCMDECHO (getvar "CMDECHO"))
  (Setvar "CMDECHO" 0)
  (setq vZERO 8.8817843e-16)
  (Setq ss1 (ssadd))
  (Setq ss2 (ssadd))
  
  (initget "All Window ")
  (setq selOption
	 (getkword
	   "Select objects [Window/All] <All>: "
	   )
	)
  (If (= selOption "Window")
    (progn
      (setq
	s1 (getcorner
	     (setq f1
		    (getpoint
		      "Specify first corner: "
		      )
		   )
	     "Specify opposite corner: "
	     )
	)
      (While (= (sslength ss1) 0)
	(Command "_Zoom" "_W" f1 s1)
	(Setq ss1 (ssget "_w" f1 s1))
	)
      )
    (progn
      (Command "_zoom" "_e")
      (setq SS1 (ssget "_x" '((0 . "LINE"))))
      )
    )
  
  (setq TotLines (sslength ss1))
  
  (if (< TotLines 2)
	(progn
	  (Alert
	    "No overlapping lines found in the selection!\n\n
The program ends!!"
	    )
	  (setvar "CMDECHO" oCMDECHO)
	  (setvar "OSMODE" oOSMODE)
	  (princ)
	  (exit)
	  )
	)
  (setq lDone 0)
  (While (< lDone TotLines)
    (setq bLine (ssname ss1 lDone))
    (setq lDone (1+ lDone))
    (setq pt (cdr (assoc 10 (entget bLine))))
    (setq ss2 (ssget "_c" pt pt '((0 . "LINE"))))
    (if (/= ss2 nil)
      (processSS1)
      )
    )
  (setvar "CMDECHO" oCMDECHO)
  (setvar "OSMODE" oOSMODE)
  (princ)
  )

(defun ProcessSS1 ()
  (if (> (sslength ss2) 1)
    (progn
      (setq ss2 (ssdel bLine ss2))
      (while (> (sslength ss2) 1)
	(ssdel (ssname ss2 (- (sslength ss2) 1)) ss2)
	)
      (setq pt1 (cdr (assoc 10 (entget bLine)))
	    pt2 (cdr (assoc 11 (entget bLine))))
      (setq sLine (ssname ss2 0))
      (setq sLinEdata (entget sLine))
      (setq pt3 (cdr (assoc 10 sLinEdata))
	    pt4 (cdr (assoc 11 sLinEdata))
	    )
      (processSS2)
      )
    )
  )

(defun ProcessSS2 ()
  (if (= (inters Pt1 Pt2 pt3 Pt4)
	 nil
	 )
    (progn
      (if
	(or
	  (And
	    (< (abs (- (angle Pt3 Pt1)
		       (angle Pt3 Pt2)
		       )
		    )
	       vZERO
	       )
	    (< (abs (- (angle Pt4 Pt1)
		       (angle Pt4 Pt2)
		       )
		    )
	       vZERO
	       )
	    (and
	      (/= (distance Pt1 Pt3) 0)
	      (/= (distance Pt2 Pt4) 0)
	      )
	    (and
	      (/= (distance Pt1 Pt4) 0)
	      (/= (distance Pt2 Pt3) 0)
	      )
	    )
	  (or
	    (and
	      (= (distance Pt1 Pt3) 0)
	      (= (distance Pt2 Pt4) 0)
	      )
	    (and
	      (= (distance Pt1 Pt4) 0)
	      (= (distance Pt2 Pt3) 0)
	      )
	    )
	  (and (or (= (distance Pt1 Pt3) 0)
		   (= (distance Pt1 Pt4) 0)
		   (= (distance Pt2 Pt3) 0)
		   (= (distance Pt2 Pt4) 0)
		   )
	       (or (> (abs
			(- (angle Pt3 Pt1)
			   (angle Pt3 Pt2)
			   )
			) vZero
		      )
		   (> (abs
			(- (angle Pt4 Pt1)
			   (angle Pt4 Pt2)
			   )
			) vZero
		      )
		   ) ;_ end of or
	       )
	  )
	(progn


;;; Modified by BeekeeCZ 2015/01

	  (entmod (append (entget bLine)  '((62 . 1))))

;;; End of modification made by BeekeeCZ 2015/01


	  (setq obj1
		 (vlax-ename->vla-object bLine)
		)
	  (vla-highlight obj1 "True")


	  
;;;	  (initget "Yes No")
;;;	  (setq delLin
;;;		 (getkword
;;;		   "This line is being 'embedded' by another line.\n\n
;;;You can confirm by zooming transparently.
;;;\n\nDo you want to delete it? [No] or Yes: "
;;;		   )
;;;		)
;;;	  (if (= delLin "Yes")
;;;	    (progn
;;;	      (entdel bLine)
;;;	      (ssdel bLine ss2)
;;;	      )
;;;	    )
;;;	  (command "_regen")



	  
	  )
	)
      )
    )
  )
(alert
  "Type 'Overlap' at the command
prompt to run this program"
  )
;;; ================

Next time I recommend to use the proper forum.

[kite15]

Hi BeeKeeCZ,

Thanks for the Lisp code.

I tried your code, after review on some line objects and seen it does not work properly.

Since some of lines has been changed as per needs but, few line objects not affected on the selection set.

have any version issue of AutoCAD??

[ВeekeeCZ]

I don't understand the issue. The routine does no selection set. Overlapping objects are just highlighted and colored in red. If some objects are highlighted and NOT colored, then post the dwg sample where this happened.

[sadishpaul]

Hi,,

your code works great .. 

can i have a similar code for circles  ?

regards,

paul

[aaron_gonzalez1]

i tried the lisp, but only indentify lines whit overlaping, can you modify the lisp for consider Plines, block, circles arcs, please.