Possible to make extra thing in this code?

Hello,

This routine removes duplicated blocks belonging to the same group name.

That's great but i would like first see wich one is duplicated before he's deleting!

Actually he's only said "x blocks delete" but you don't know where on the plan.

So after command it's possible to have this:

1) with a selection, you can see where are all duplicate blocks

2) than delete

(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 (

(setq obj (vlax-ename->vla-object (ssname ss cnt)))

(if (and

(not obj)

(

)

(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 (vlax-get-property obj

(if (vlax-property-available-p obj 'EffectiveName) 'EffectiveName 'Name))

)

(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 (vlax-get-property objc

(if (vlax-property-available-p objc 'EffectiveName) 'EffectiveName 'Name))

)

(setq dist (distance sa sac))

(if (and

(= (vla-get-name obj) (vla-get-name objc))

(/= (vla-get-objectid obj)

(vla-get-objectid objc)

)

(

)

(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

You colud put something possibly here before this command (vla-delete objc) like a (getstring "press enter") not tested.

I just make a copy/paste...i don't understand lisp code.

That's the reason why i'm looking for help.

Try this program and let know how things get on with you .

(defun c:Test (/ b nm bks ss i sn e l lst g n)
 ;;------------------------------------;;
 ;;	Tharwat 20.05.2015		;;
 ;;	Highligh Duplicated blocks	;;
 ;;------------------------------------;;
 (while (setq b (tblnext "BLOCK" (not b)))
   (if (and (not (assoc 1 b))
            (not (wcmatch (setq nm (cdr (assoc 2 b))) "*|*"))
       )
     (setq bks (cons nm bks))
   )
 )
 (princ
   "\nSelect Blocks to highligh duplicates in position :"
 )
 (if (setq g  (ssadd)
           ss (ssget
                "_:L"
                (list
                  '(0 . "INSERT")
                  (cons
                    2
                    (apply 'strcat (mapcar '(lambda (u) (strcat u ",")) bks))
                  )
                )
              )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i)))
             e  (entget sn)
             l  (cons (list sn (cdr (assoc 10 e))) l)
       )
     )
     (mapcar '(lambda (p)
                (if (vl-some '(lambda (q)
                                (and
                                  (equal (cadr p) (cadr q) 1e-4)
                                  (not (eq (car p) (car q)))
                                  (not (member (cadr q) lst))
                                )
                              )
                             l
                    )
                  (progn
                    (setq lst (cons (cadr p) lst))
                    (ssadd (car p) g)
                  )
                )
              )
             l
     )
     (if (< 0 (setq n (sslength g)))
       (princ (strcat "\nNumber of Duplicated Blocks found [ "
                      (itoa n)
                      " ] :"
              )
       )
       (princ "\nNo duplicate Blocks found !")
     )
   )
 )
 (sssetfirst nil g)
 (princ)
)

Tharwat....again!!!

This lisp also select a xref who's not a duplicate in my plan.

It's possible to have this only for blocks, without xrefs option?

Thanks!

Tharwat....again!!!

Again and again

CODES UPDATED ABOVE .

and once again...amazing job!!!

See you next time

Thank you!!!!!

and once again...amazing job!!!

See you next time

 

Thank you!!!!!

You're most welcome .