Remove Duplicate Entities / Obects in autocad drawing using Auto LISP

Copy and Paste the below code to Remove Duplicate entities \ objects using LISP in Auto cad Drawing this will catch duplicate entities like Blocks,Points & Lines


copy the below lisp code and make this as and appload the lisp fiel in to autocad application and type commnad "REMDUP"






;start copy here

; Loads Visual LISP extensions to AutoLISP
(vl-load-com)

;; this will cll the fiu
(defun C:remDup()
  (command "undo" "begin")
  (Removeduplicateentities)
  (command "undo" "end")
  (princ)
)

;this is the main function to find duplicate entities/Objects in Autocad
;this is very fast method
;this will catch duplicate entities like Blocks,Point,Line only
;this will not apply for polyline,Lwpolyline
(defun Removeduplicateentities (/ $acad $adoc $mspa ent objname ins bname stp enp lay errcnt dupset)
  (setq    $acad (vlax-get-acad-object)
    $adoc (vla-get-activedocument $acad)
    $mspa (vlax-get-property $adoc 'modelspace)
    errcnt 0
  ) ;_ end of setq
  (vlax-for obj    $mspa
    (setq ent      (vlax-vla-object->ename obj)
      objname (vlax-get-property obj 'objectname)
    ) ;_ end of setq
    (cond
      ((eq objname "AcDbBlockReference")
       (setq ins   (vlax-get obj 'insertionpoint)
         bname (vlax-get obj 'name)
       ) ;_ end of setq
       (if (> (sslength  (setq dupset (ssget "x" (list (cons 2 bname) (cons 10 ins))))) 1)
     (progn
       (setq dupset (ssdel ent dupset))
       (setq errcnt (+ (sslength dupset) errcnt))
       (command "erase" dupset "")
     ) ;_ end of progn
       ) ;_ end of if
      )
      ((eq objname "AcDbPoint")
       (setq ins (vlax-get obj 'Coordinates))
         lay (vlax-get obj 'layer)
       (if (>(sslength  (setq dupset (ssget "x" (list (cons 0 "POINT") (cons 10 ins))))) 1)
     (progn
       (setq dupset (ssdel ent dupset))
       (setq errcnt (+ (sslength dupset) errcnt))
       (command "erase" dupset "")
     ) ;_ end of progn
       ) ;_ end of if
      )
      ((eq objname "AcDbLine")
       (setq stp (vlax-get obj 'startpoint)
         enp (vlax-get obj 'endpoint)
         lay (vlax-get obj 'layer)
       ) ;_ end of setq
       (if (>   (sslength (setq dupset (ssget "x" (list (cons 10 stp) (cons 11 enp))))) 1)
     (progn
       (setq dupset (ssdel ent dupset))
       (setq errcnt (+ (sslength dupset) errcnt))
       (command "erase" dupset "")
     ) ;_ end of progn
       ) ;_ end of if
      )
    ) ;_ end of cond
  ) ;_ end of VLAX-FOR
  (princ (strcat "\r\n" (itoa errcnt) " Duplicate Entities Removed"))
  (princ)
) ;_ end of defun


;;
(princ "\r\nEnter Commnad for removing (deleting) Duplicates is REMDUP")
(princ)


;end copy here

Find Duplicate Entities / Obects in autocad drawing using Auto LISP

Copy and Paste the below code to find Duplicate entities \ objects using LISP in Auto cad Drawing this will catch duplicate entities like Blocks,Points & Lines


copy the below lisp code and make this as and appload the lisp fiel in to autocad application and type commnad "DUP"




;start copy form here
; Loads Visual LISP extensions to AutoLISP
(vl-load-com)

;; this will cll the fiu
(defun C:Dup()
  (duplicateentities)
)

;this is the main function to find duplicate entities/Objects in Autocad
;this is very fast method
;this will catch duplicate entities like Blocks,Point,Line only
;this will not apply for polyline,Lwpolyline

(defun duplicateentities (/ $acad $adoc $mspa ent objname ins bname stp enp lay errcnt)
  (setq    $acad (vlax-get-acad-object)
    $adoc (vla-get-activedocument $acad)
    $mspa (vlax-get-property $adoc 'modelspace)
    errcnt 0
  ) ;_ end of setq
  (vlax-for obj    $mspa
    (setq ent      (vlax-vla-object->ename obj)
      objname (vlax-get-property obj 'objectname)
    ) ;_ end of setq
    (cond
      ((eq objname "AcDbBlockReference")
       (setq ins   (vlax-get obj 'insertionpoint)
         bname (vlax-get obj 'name)
       ) ;_ end of setq
       (if (> (sslength (ssget "x" (list (cons 2 bname) (cons 10 ins)))) 1)
     (progn
       (markerror ent (strcat "Duplicate objects found [" bname "]") nil)
       (setq errcnt (1+ errcnt))
     ) ;_ end of progn
       ) ;_ end of if
      )
      ((eq objname "AcDbPoint")
       (setq ins (vlax-get obj 'Coordinates))
         lay (vlax-get obj 'layer)
       (if (> (sslength (ssget "x" (list (cons 0 "POINT") (cons 10 ins)))) 1)
     (progn
       (markerror ent (strcat "Duplicate objects found [" lay "]") nil)
       (setq errcnt (1+ errcnt))
     ) ;_ end of progn
       ) ;_ end of if
      )
      ((eq objname "AcDbLine")
       (setq stp (vlax-get obj 'startpoint)
         enp (vlax-get obj 'endpoint)
         lay (vlax-get obj 'layer)
       ) ;_ end of setq
       (if (> (sslength (ssget "x" (list (cons 10 stp) (cons 11 enp)))) 1)
     (progn
       (markerror ent (strcat "Duplicate objects found [" lay "]") nil)
       (setq errcnt (1+ errcnt))
     ) ;_ end of progn
       ) ;_ end of if
      )
    ) ;_ end of cond
  ) ;_ end of VLAX-FOR
) ;_ end of defun


;it will mark error (place circle in error layer) in model
(defun markerror (e er f / el etyp handle ip)
  (setq    el     (entget e)
    etyp   (strcase (cdr (assoc 0 el)))
    handle (cdr (assoc 5 el))
    ip     (cond
         ((wcmatch etyp "*LINE")
          (vlax-get-midpoint e)
         )
         (t
          (cdr (assoc 10 el))
         )
           ) ;_ end of cond
  ) ;_ end of setq
  (entmake
    (list (cons 0 "circle") (cons 8 "Error") (cons 10 ip) (cons 62 2) (cons 40 15))
  ) ;_ end of entmake
  (if f
    (write-line (strcat er " For object " handle) f)
  ) ;_ end of if
) ;_ end of defun



;this function will get mid point for LINE,POLYLINE,LWPOLYLINE
(defun vlax-get-midpoint (e / ve)
  (setq ve (vlax-ename->vla-object e))
  (if (= (vlax-curve-getendparam ve) 0)
    (vlax-curve-getstartpoint ve)
    (vlax-curve-getpointatdist
      ve
      (/ (vlax-curve-getdistatparam ve (vlax-curve-getendparam ve)) 2)
    )
  )
) ;_ end of defun


;;
(princ "\r\nEnter Commnad for finding Duplicates is DUP")
(princ)
;End Copy here