;;-----------------=={ Copy/Rename Block Reference }==------------------;;
;;                                                                      ;;
;;  This program allows a user to copy and/or rename a single block     ;;
;;  reference in the working drawing.                                   ;;
;;                                                                      ;;
;;  Many existing programs enable the user to rename the block          ;;
;;  definition for a given block reference, with the new name           ;;
;;  subsequently reflected across all references of the block           ;;
;;  definition in the drawing. However, this program will allow a       ;;
;;  single selected block reference to be renamed (or for the user to   ;;
;;  create a renamed copy of the selected block reference), by          ;;
;;  generating a duplicate renamed block definition for the selected    ;;
;;  block.                                                              ;;
;;                                                                      ;;
;;  The program may be called from the command-line using either 'CB'   ;;
;;  to create a renamed copy of a selected block reference, or 'RB' to  ;;
;;  simply rename the selected block reference.                         ;;
;;                                                                      ;;
;;  Following selection of a block reference, the user is prompted to   ;;
;;  specify a name for the selected/copied block reference; a default   ;;
;;  block name composed of the original block name concatenated with    ;;
;;  both an underscore and the minimum integer required for uniqueness  ;;
;;  within the block collection of the active drawing is offered.       ;;
;;                                                                      ;;
;;  The program will then proceed to duplicate the block definition     ;;
;;  using the new block name. To accomplish this without resulting in   ;;
;;  a duplicate key in the block collection of the active drawing, the  ;;
;;  program utilises an ObjectDBX interface to which the block          ;;
;;  definition of the selected block reference is deep-cloned, renamed, ;;
;;  and then deep-cloned back to the active drawing. This method also   ;;
;;  enables Dynamic Block definitions to be successfully copied         ;;
;;  & renamed.                                                          ;;
;;                                                                      ;;
;;  Finally, this program will perform successfully in all UCS/Views    ;;
;;  and is compatible with Anonymous Blocks, Dynamic Blocks & XRefs.    ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    05-07-2013                                      ;;
;;----------------------------------------------------------------------;;

;;¸´ÖÆ²¢ÖØÃüÃûµÄÍ¼¿é[LM_cbblock]
(defun c:LM_cblock ( / old_cmd abc app dbc dbx def doc dxf new old prp src tmp vrs )
    (mini_start nil)
    (setq src (car (mai_Entsel nil "Ñ¡ÔñÐèÒª¸´ÖÆ²¢ÖØÃüÃûµÄÍ¼¿é:<ÍË³ö>" "Ñ¡ÔñµÄ²»ÊÇÍ¼¿é." '((0 . "insert")) nil)))
    (or src (exit))
    (setq tmp (entlast)
          dbx (getpoint "\nÊäÈë¸´ÖÆ»ùµã:<ÍË³ö>")
    )
    (or dbx (exit))
    (command "_.copy" src "" "non" dbx)
    (mai_com_pause)
    (setq src (entlast))
    (and (eq tmp src) (exit))
    (setq app (vlax-get-acad-object)
          doc (vla-get-activedocument app)
          src (vlax-ename->vla-object src)
          old (mai_block_name src)
          tmp 0
          dbx (strcat (vl-string-left-trim "*" old) "_REN_")
    )
    (while (tblsearch "block" (setq def (strcat dbx (itoa (setq tmp (1+ tmp)))))))
    (while
        (and (setq new (mai_txtedit def "¸´ÖÆÍ¼¿é²¢ÊäÈëÐÂµÄ¿éÃû"))
             (or (not (snvalid new))
                 (tblsearch "block" new)
             )
        )
        (princ "\nÊäÈëµÄ¿éÃûÒÑ¾­´æÔÚÍ¼ÖÐ.")
    )
    (if (mai_not_str new)
        (setq new def)
    )
    (setq app (vlax-get-acad-object)
          vrs (atoi (getvar 'acadver))
          vrs (if (< vrs 16) "" (strcat "." (itoa vrs)))
          vrs (strcat "objectdbx.axdbdocument" vrs)
          dbx (vl-catch-all-apply 'vla-getinterfaceobject (list app vrs))
    )
    (if (or (null dbx) (vl-catch-all-error-p dbx))
        (progn
            (princ "\nÎÞ·¨·ÃÎÊ ObjectDBX.")
            (exit)
        )
    )
    (setq abc (vla-get-blocks doc)
          dbc (vla-get-blocks dbx)
    )
    (vlax-invoke doc 'copyobjects (list (vla-item abc old)) dbc)
    (vla-put-name (vla-item dbc (if (wcmatch old "`**") (1- (vla-get-count dbc)) old)) new)
    (vlax-invoke dbx 'copyobjects (list (vla-item dbc new)) abc)
    (vlax-release-object dbx)
    (setq src (vla-copy src))
    (if (and
            (vlax-property-available-p src 'isdynamicblock)
            (= :vlax-true (vla-get-isdynamicblock src))
        )
        (progn
            (setq prp (mapcar 'vla-get-value (vlax-invoke src 'getdynamicblockproperties)))
            (vla-put-name src new)
            (mapcar
                '(lambda ( a b )
                    (if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
                        (vla-put-value a b)
                    )
                 )
                 (vlax-invoke src 'getdynamicblockproperties)
                 prp
            )
        )
        (vla-put-name src new)
    )
    (setq def (vla-item (vla-get-blocks doc) new))
    (if (= :vlax-true (vla-get-isxref def))
        (vla-reload def)
    )
    (sssetfirst nil (ssadd (vlax-vla-object->ename src)))
    (mai_end)
)
