программа для копирования/вставки текста в атрибуты блока

;|
;|
Подпрограмма выбора из блока наименований проекта и объекта и запись в файл
Пример вызова (nz_shtamp_read )
|;
(defun nz_shtamp_read (/ sp_atr el fname i fl str)
;;;     sp_atr - список атрибутов нужных в блоке
  (setq    sp_atr '(("OD1" . "")
         ("S1PR" . "")
         ("S2PR" . "")
         ("S3PR" . "")
         ("S1P" . "")
         ("S2P" . "")
         ("S3P" . "")
         ("ST" . "")
        )
;;;   файл с данными штампа в рабочей папке
    fname  (strcat (getvar "dwgprefix") "\\shtamp.txt")
    i      0
  ) ;_ конец setq
  (if (setq el (nz_vybor_blk))
    (progn
      (setq sp_atr_new
         (nz_att_read (ssname el (1- (sslength el))) sp_atr)
      )
;;; Запишем в файл
      (setq fl (open fname
             "w"
           ) ;_ конец open
      ) ;_ конец setq
      (while (setq str (cdr (nth i sp_atr_new)))
    (write-line str fl)
    (setq i (1+ i))
      ) ;_ конец while
      (close fl)
    )
    (prompt "\n Отменили, так отменили")
  )
  (princ)
) ;_ конец defun

;;; выбор блока штампа с именем "nz_shtaru"
;;;------------------------------------------------------
(defun nz_vybor_blk (/ r)
  (prompt "\n Укажите блок штампа")
  (vl-catch-all-apply
    '(lambda ()
       (setq r (ssget '((0 . "INSERT") (2 . "nz_shtaru"))))
     ) ;_ end of lambda
  ) ;_ end of vl-catch-all-apply
  (setq    r (if r
        r
        nil
      ) ;_ конец if
  ) ;_ конец setq
) ;_ конец defun

;;; ===================      ЗАМЕНА ЗНАЧЕНИЙ АТРИБУТОВ ========================================
(defun nz_att_read
       (el_sp sp_atr / att seqend a_name new_value att0 att)
;;;   el_sp - список примитивов блока
  (setq att (entnext el_sp))
  (setq seqend (cdr (assoc 0 (entget att))))
;;; ; пока есть атрибуты в блоке
  (while (not (eq seqend "SEQEND"))
;;;                ; находим  атрибут
    (setq a_name (cdr (assoc 2 (entget att))))
;;;  значение ЭТОГО атрибута
    (setq new_value (cdr (assoc 1 (entget att))))
;;; начинаем проверять по списку для изменений: есть атрибут - меняем в списке
    (if    new_value
      (setq sp_atr (subst (cons a_name new_value)
              (assoc a_name sp_atr)
              sp_atr
           ) ;_ конец subst
      ) ;_ конец setq
    ) ;_ конец if
    (setq att (entnext att))
    (setq seqend (cdr (assoc 0 (entget att))))
  ) ;_ конец while
  sp_atr
) ;_ конец defun