Простой перенумератор

;;==========================================================================
;;;;            Рабочая программа перенумерации  DTEXT, MTEXT,  атрибутов Блоков
;;;;                Гуськов Вячеслав  (  aka guslav)    11-01-08
;;;;==========================================================================
(defun C:rnm  ( / rnm:Pref rnm:Start Str curText  curStr)
(vl-load-com)
(setq Str (gu-ent-text )); выбрали образец  и он правильный
(setq rnm:Pref (car Str ));
(setq rnm:Start (cdr Str));и разложили на переменную и постоянную составляющие
(setq rnm:Start (itoa (+ 1 (atoi rnm:Start)))); Увеличили переменную часть на 1 для следущего выбора
(while T
(setq curStr(strcat rnm:Pref rnm:Start)) 
(setq rnm:Start (atoi rnm:Start))
(setq curText  (car  (nentsel "\n>>    Выберите следующие значения  DText/MText/атрибут блока для изменения или Esc чтобы завершить программу ")))
        (if
        (and  curText(member(cdr(assoc 0(entget curText))) '("TEXT" "MTEXT" "ATTRIB"))); end and
            (progn
                (vla-put-TextString (vlax-ename->vla-object curText)curStr)
                (setq rnm:Start(1+ rnm:Start))
            ); end progn
                (princ "\n<< Ошибка выбора объекта. Это не  DText, MText или атрибут блока ! >>")
        ); end if
    (setq rnm:Start (itoa rnm:Start))
  ); end while
  (princ)
); end of 
;;=====================================================================
;;====================================================================
  (defun *error* (msg) (princ "\n<<  Принудительное завершение работы программы  >>")
    (cond
      ((not msg))
      ((member msg '("Function cancelled" "quit / exit abort")))
      ((princ (strcat "\nError: " msg))
       (cond (*debug* (vl-bt)))
       )
      ) ;_ end of cond
        ) ;_ end of defun
      (princ "\n>>  Для запуска набери rnm, для справки набери rnm? " )
      (princ)
;;==========================================================================
;;Функция определения имени  выбранного примитива - рабочая
;;==========================================================================
(defun  gu-ent-text ( / nm action b1 vb)
(while (= action nil)
(while (null (and nm (car (member nm  '("TEXT" "MTEXT" "INS ERT"))))); работает строка
        (setq bl (entsel "\n\n>>  ВЫБЕРИTE КУРСОРОМ  НА ЧЕРТЕЖЕ ИСХОДНЫЙ БЛОК, ТЕХТ или МТЕКСТ (  Для выхода нажмите ESC )"))
            (while (null bl) (setq bl (entsel "\n<<  ОБЪЕКТ НЕ ВЫБРАН, ПОВТОРИTE  ( Для выхода нажмите ESC ) >>")))
        (setq nm (cdr (assoc 0 (entget (car bl)))))
            (if (and nm (member nm  '("TEXT" "MTEXT" "INS ERT"))) (princ "\n" ) (princ "\n<<  Ошибка. Неправильный выбор объекта  >>")
            );if
);while
(setq action (gu-GetConstVarNumber 
(cond 
((= nm "INS ERT")(bl-name bl))
((= nm "TEXT")(cdr (assoc 1 (entget (car bl)))))
((= nm "MTEXT")(  _kpblc-clear-mtext (cdr (assoc 1 (entget(car bl)))))); Вариант крыса c форматированием
); cond
));setq
(if (= action nil) 
(princ "\n<<  Ошибка. У объекта нет изменяемой части  >>")
)
(setq bl nil nm nil vb action)
);while
(princ "<<  Выбрано исходное значение ") (princ (strcat (car vb ) (cdr vb)  "   >>"))
(setq vb action)
); end defun
;===============================================================================
(defun bl-name ( blk / block_data bln) 
(setq bln blk)
(setq block_data (get-all-atts (vlax-ename->vla-object (car bln))))
(setq blk (cdar  block_data));Выбираем 2-й из первого
)
(defun get-all-atts (obj)
    (if  (and obj
       (vlax-property-available-p obj 'Hasattributes)
       (eq :vlax-true (vla-get-hasattributes obj)))
      (vl-catch-all-apply
  (function
    (lambda ()
      (mapcar (function (lambda (x)
    (cons (vla-get-tagstring x)
      (vla-get-textstring x))))
        (append (vlax-invoke obj 'Getattributes)
          (vlax-invoke obj 'Getconstantattributes))))))))
;;====================================================================================== 
;|====================================================================================== 
;;             Функция сносит форматирование многострочного текста. Удаляются символы "{"   
;;           и "}", поскольку именно символ "}" является окончанием применения определенного
;;          фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п.                     
;;           Параметры вызова:
;;           tring-to-normalize  — строка, которую надо нормализовать
;;           Примеры вызова:
;;           (  _kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))))
;;           для выбранного многострочного текста очищает форматирование.
;;              Редакция VVA
;;=============================================================================|;
(defun _kpblc-clear-mtext (string-to-normalize     /
         sub_string       sub_pos         left_string
         right_string
         )
  (if (or
  (setq sub_pos (vl-string-search "{f" string-to-normalize))
  (setq sub_pos (vl-string-search "{\\" string-to-normalize))
  (setq sub_pos (vl-string-search "\\f" string-to-normalize))
  (setq sub_pos (vl-string-search "{\\f" string-to-normalize))
  ) ;_ end of or
    (progn
      (setq left_string      ;все, что до "{"
       (vl-string-trim
         "{"
         (substr
     string-to-normalize
     1
     (vl-string-position
       (ascii "\\")
       string-to-normalize
       sub_pos
       ) ;_ end of vl-string-position
     ) ;_ end of substr
         ) ;_ end of vl-string-trim
      ) ;_ end of setq

      (if (vl-string-position
      (ascii ";")
      string-to-normalize
      sub_pos
      ) ;_ end of vl-string-position
  (setq right_string    ;все, что между {f и ;
         (substr
     string-to-normalize
     (+ (vl-string-position
          (ascii ";")
          string-to-normalize
          sub_pos
          ) ;_ end of vl-string-position
        2
        ) ;_ end of +
     ) ;_ end of substr
        ) ;_ end of setq
  (setq right_string "")
  ) ;_ end of if
      (_kpblc-clear-mtext (strcat left_string right_string))
      ) ;_ end of progn
    (vl-list->str ing
      (vl-remove
  (ascii "}")
  (vl-string->list string-to-normalize)
  ) ;_ end of vl-remove
      ) ;_ end of vl-list->string
    ) ;_ end of if
  ) ;_ end of defun
;; ================================================================================
;; Функция выделения из текстовой цепочки изменяемой и постоянных частей, помещаемых в список
;; Изменяемая часть - целое число с правой стороны текста до первого символа-не числа,
;; например,  ABC4/55 - здесь 55 - переменная часть, ABC4/ - постоянная часть
;;                                
;;        Гуськов Вячеслав  (  aka guslav )                                                
;;==================================================    
(defun gu-GetConstVarNumber ( CurStr / LengthSpis  Spis SpisVar SpisConst num)
(setq Spis (vl-string->list CurStr));  число и переводим в список чисел
(setq LengthSpis (length Spis)); Длина всего символа 
(setq SpisVar (list))
(setq SpisConst (list))
(setq LengthSpis (- LengthSpis 1))
(setq num (nth LengthSpis Spis)); первый элемент перед входом в цикл
(while ( and (>= LengthSpis 0) (> num 47) (< num 58)) 
        (setq num (nth LengthSpis Spis))
    (if (and (> num 47) (< num 58))
        (setq SpisVar ( cons num SpisVar))
        (setq LengthSpis (+ LengthSpis 1)); попалось не число, увеличиваем на 1 ,чтобы его не потерять при выходе из цикла 
    );if
        (setq LengthSpis (- LengthSpis 1))
); while
(while (>= LengthSpis 0)
        (se tq num (nth LengthSpis Spis))
        (se tq SpisConst( cons num SpisConst))
        (se tq LengthSpis (- LengthSpis 1))
); while
(if (/= SpisVar nil)
(cons (vl-list->string SpisConst) (vl-list->string SpisVar))
)
);defun
;;============================================================================================================
(defun C:RNM? ( / )
(alert " 
    Это программа для последовательной перенумерации любых текстов и обозначений блоков на чертеже.

    Для начала вы выбираете курсором на чертеже первое обозначение блока или какой-то текст, как образец.
    
    Обязательное условие:  текст или обозначение должны заканчиваться хотя бы одной цифрой.    
    
    После этого выбираете следующий объект, который будете менять.    
    
    Выбранное обозначение блока или текст примет вид исходного обозначения, увеличенного на 1.
    
    Выбирая  объекты один за другим, вы получите цепочку последовательно пронумерованных объектов.    
    
    Для запуска программы наберите  rnm  в командной строке АвтоКада.  Чтобы получать диагностические 
    
    сообщения программы, желательно открыть 2-3 строки диагностической области над командной строкой.    
    
    Внимание: при работе с блоками при первоначальном выборе образца можно  выбрать курсором   любое место блока,    

    но при дальнейшем переименовании блоков необходимо выбирать курсором  только  атрибут блока,
    
    т.е непосредственно  его текстовое обозначение.    
    
    Второе. При работе с МMTEXT он не должен иметь переносов, т.е должен быть однострочным.
    
    Третье. В конце обозначения не должно быть пробелов, на чертеже их не видно,но программа примет их за нецифру.
    
    
                        Все вопросы к Гуськову Вячеславу 
);alert
;;============================================================================================================================
 (princ)
);defun