(defun CloneBlock (Old New / Doc Blocks Block Objects)
  ;; CloneBlock.lsp (01-01-04), John F. Uhden, Cadlantic.
  ;; Revised (01-04-04):
  ;;   Added in-line comments.
  ;;   Allowed for cloning empty blocks, but with a prompt.
  ;;   Changed to use of simpler (vlax-invoke) methodology.
  ;; Function dedicated to Mike Evans to create a new block
  ;;   from an existing block.
  ;; Arguments:
  ;;   Old - existing block name as a string
  ;;   New - new block name as a string
  ;; Returns:
  ;;   The block record as a VLA-Object if successful, or
  ;;   nil if not successful.
  ;; Note:
  ;;   Can be used to create an anonymous block
  ;;   using "*U" as the New name
  (gc)
  (vl-load-com)
  (and
    ;; Check for the existence of the Old block by name, or
    ;; cease further evaluation with a (prompt), which always
    ;; returns nil
    (or
      (tblobjname "block" Old)
      (prompt (strcat "\nNo block definition named " Old))
    )
    ;; Check for the absence of the New block by name, or
    ;; cease further evaluation with a (prompt), which always
    ;; returns nil
    (or
      (not (tblobjname "block" New))
      (prompt (strcat "\nBlock named " New " exists."))
    )
    ;; If so far so good, set the symbols for the
    ;; ActiveDocument object and its Blocks collection.
    (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object))
          Blocks (vla-get-blocks Doc)
    )
    ;; Convert the Old value to its VLA-Object block record.
    (setq Old (vla-item Blocks Old))
    ;; Either create a New block definition, which will be
    ;; empty, or cease further evaluation with a (prompt),
    ;; which always returns nil
    (or
      (setq Block (vla-add Blocks (vla-get-origin Old) New))
      (prompt (strcat "\nUnable to make block named " New))
    )
    ;; Either build a list of objects contained in the Old
    ;; block definition, or cease further evaluation with
    ;; a (prompt), which always returns nil.
    ;; Nevertheless, the New block has been created.
    (or
      (vlax-for Item Old
        (setq Objects (cons Item Objects))
      )
      (prompt "\nBlock definition contains no objects.")
    )
    ;; Note that the (vlax-invoke) methodology used in this
    ;; example cannot return the optional 'IDPairs variant.
    (vl-catch-all-error-p
      (vl-catch-all-apply
       'vlax-invoke
        (list Doc 'CopyObjects (reverse Objects) Block)
      )
    )
    ;; If there was an error, then evaluation continues,
    ;; so delete the erroneous block record,
    (not (vla-delete Block))
    ;; and set its value to nil via (prompt)
    (setq Block (prompt "\nUnable to add objects to block definition."))
  )
  ;; Return the block record VLA-Object, if it exists.
  Block
)