Delete duplicate dynamic Blocks

[Anonymous]

Hello Everyone

Found this code from Odie Silva which delete duplicate blocks with same insertion point (it deletes all duplicates but leave one) it works great on regular blocks but doeasnt work on dynamic blocks with visibility. It should include effective name somewhere. Please Help....Thanks in advance

;REMDUP.LSP - Removes duplicated blocks belonging to the same group name
;
;Code by: Odie Silva
;Written in February 2003 - Note: Improved version will provide dialog for
; tolerance input.
(defun c:remdup (/ cntdup cnt cntc obj_name object_namec sslen sslec)
(setvar "cmdecho" 0)
(vl-load-com)
(setq app (vlax-get-acad-object))
(setq doc (vla-get-activedocument app))
(setq mspace (vla-get-modelspace doc))
(vla-startundomark doc)
(vla-ZoomExtents app)
(Princ "\nSelecting All Blocks...\n")
(setq ss (ssget "x" '((0 . "INSERT"))))
(setq sslen (sslength ss))
(setq cnt 0)
(setq cntdup 0)
(princ (strcat (rtos sslen 2 0) " blocks found!"))
(while (< cnt sslen)
(setq obj (vlax-ename->vla-object (ssname ss cnt)))
(if (and
(not obj)
(< cnt sslen)
)
(setq cnt (1+ cnt))
(progn
(setq obj_insertion (vla-get-insertionpoint obj))
;;; (vla-ZoomCenter
;;; app
;;; obj_insertion
;;; (vlax-make-variant 10 vlax-vbDouble); this will force to zoom into
;;; ); ; element being processed
(setq
sa (vlax-safearray->list (vlax-variant-value obj_insertion))
)
(setq obj_name (vla-get-name obj))
(if (/= obj_name "ADCADD_ZZ")
(progn
(setq wpt1 (polar sa (cvunit 45 "degree" "radians") 15))
(setq wpt2 (polar sa (cvunit 225 "degree" "radians") 15))
(setq ssc (ssget "c" wpt1 wpt2 '((0 . "INSERT"))))
(if ssc
(progn
(setq cntc 0)
(setq sslenc (sslength ssc))
(if (> sslenc 1)
(progn
(while (/= cntc sslenc)
(setq
objc
(vlax-ename->vla-object (ssname ssc cntc))
)
(setq obj_insertionc
(vla-get-insertionpoint objc)
)
(setq sac (vlax-safearray->list
(vlax-variant-value obj_insertionc)
)
)

(setq obj_namec (vla-get-name objc))
(setq dist (distance sa sac))
(if (and
(= (vla-get-name obj) (vla-get-name objc))
(/= (vla-get-objectid obj)
(vla-get-objectid objc)
)
(<= dist 0.1)
)
(progn
(vla-delete objc)
(setq cntdup (1+ cntdup))
)
)
(setq cntc (1+ cntc))
)
) ;end of progn
) ;end of if
) ;end of progn
) ;end of if
) ;end of progn
) ;end of if
) ;end of progn
) ;end of if
(setq cnt (1+ cnt))
) ;end of while
(vla-ZoomPrevious app)
(alert (strcat (rtos cnt 2 0)
" blocks processed!"
"
\n"
(rtos cntdup 2 0)
" blocks deleted!"
)
)
(vla-endundomark doc)
(princ)
) ;end of defun

[hmsilva · Accepted solution]

Hi JCprop.

I don't have AutoCAD in this laptop, therefore, untested...

;; try to change
(setq obj_name (vla-get-name obj))
;; to
(setq obj_name (vlax-get-property obj
		  (if (vlax-property-available-p obj 'EffectiveName) 'EffectiveName 'Name))
  )

;; and
(setq obj_namec (vla-get-name objc))
;; to
(setq obj_namec (vlax-get-property objc
		  (if (vlax-property-available-p objc 'EffectiveName) 'EffectiveName 'Name))
  )

Hope that helps
Henrique

[Anonymous]

it works as expected but now the regular blocks are ignored. Can it work on both regular and dynamic? if not then I can just use two routines (one for regular and one for dynamic.

[hmsilva · Accepted solution]

---

@Anonymous wrote:
it works as expected but now the regular blocks are ignored. Can it work on both regular and dynamic? if not then I can just use two routines (one for regular and one for dynamic.

---

It should work with dynamic and regular blocks.

The changes are just to get the effectivename propertie if exists, if not, get the name propertie...

EDIT: try the attached code

Henrique

[Anonymous]

disregard my last reply must've been seeing double already. Yes it does work on both regular and dynamic blocks. Thanks Henrique!!!!!!!!!

[hmsilva]

You're welcome, JCprog
I'm glad it works for you!

Henrique