Pages

Tuesday, October 16, 2012

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

1 comment:

Unknown said...

Superb, thank you very much.