LISP. Копирование однострочного текста из одного примитива в другие

;-------------------------------------------------------------
; Файл: CPY_TXT1.LSP
; Команда: CPY_TXT1
;
; Используется для копирования текста из одного примитива
; в другой (уже существующий).
; Примитивы могут содержаться в блоках. Это могут быть как
; обычные тексты (TEXT), так и мультитексты (MTEXT) или
; атрибуты (ATTRIB)
;
; Макрос для вставки в меню:
; ^C^C(if (null C:CPY_TXT1) (load "CPY_TXT1.LSP")) CPY_TXT1;
;
; Автор: Ривилис А.Н. (в соавторстве с Forma)
;-------------------------------------------------------------
(defun C:CPY_TXT1 (/ new_text ss ss1 e flag_sel_new flag_sel_old)
  (vl-load-com)
  (while (null flag_sel_new)
    (setvar "ERRNO" 0)
    (setq ss (car (nentsel "\nВыберите новый текст (ENTER-завершение): ")))
    (cond
      ;; Нажато ENTER - выход
      ((and (null ss) (= (getvar "ERRNO") 52))
       (setq flag_sel_new T)
      )
      ((null ss)
       (princ "\nНичего не выбрано! Повторите.") (vlr-beep-reaction)
      )
      (t
       (cond
         ;; Выбран текст - выходим из цикла
         ((setq new_text (cdr (assoc 1 (entget ss))))
          (setq flag_sel_new T)
         )
         (T
          (princ "\nВыбран не текст! Повторите.") (vlr-beep-reaction)
         )
       ) ;_ end of cond
      )
    ) ;_ end of cond
  ) ;_ end of while
  (if new_text
    (progn ;; А текст ли выбран?
       (princ (strcat "\nНовый текст: <" new_text ">"))
       (redraw ss 3)
       (while (null flag_sel_old)
         (setvar "ERRNO" 0)
         (setq ss1 (vl-catch-all-apply
            'nentsel (list "\nВыберите старый текст (ENTER-завершение): ")))
         (cond
           ((and (null ss1) (= (getvar "ERRNO") 7))
            (princ "\nНичего не выбрано! Повторите.")
            (vlr-beep-reaction)
           )
           ((/= (type ss1) 'LIST)
            (setq flag_sel_old T)
           )
           (T
            (setq e (entget (car ss1)))
            (cond
              ((assoc 1 e)
               (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
               (entmod (subst (cons 1 new_text) (assoc 1 e) e))
               ;; Если это блок - нужно его обновить,
               ;; если не блок, то обновляем только сам примитив
               (cond
                 ((cadddr ss1) (entupd (car (cadddr ss1))))
                 (T            (entupd (car ss1)))
               ) ;_ end of cond
               (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
              )
              (T
               (princ "\nВыбран не текст! Повторите.")
               (vlr-beep-reaction)
              )
            ) ;_ end of cond
           )
         ) ;_ end of cond
       ) ;_ end of while
       (redraw ss 4)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun