[DrBerD]

Доброго времени суток, форумчане!
В программировании я уже не так силен (только в школьные годы довольно неплохо занимался паскалем), а задачи приходится решать производственные, строительные. Все знают про проблему автонумерации текста в AutoCAD. Частично я для себя ее решил, нашел здесь отличный скрипт (привожу ниже в спойлере):

Код:

[Выделить все]

 ;;-----------------=={ AutoLabel Attributes }==---------------;;
;;------------------------------------------------------------;;
;;                         Settings                           ;;
;;------------------------------------------------------------;;

;; [Note: Block names and Attribute Tags are *not* case-sensitive]

(setq *blockname* "ПП-"  ;; Name of Block to be Updated
      *blocktag*  "num_pp"    ;; Attribute Tag to be Updated
)

;;------------------------------------------------------------;;
;;                      Main Program                          ;;
;;------------------------------------------------------------;;

(defun ObjectReactorCallback:RenumberBlocks ( object reactor params )
    (setq *reactor* reactor)
    (vlr-command-reactor "temp" '((:vlr-commandended . CommandReactorCallback:RenumberBlocks)))
    (vlr-remove  reactor)
    (princ)
)

;;------------------------------------------------------------;;

(defun CommandReactorCallback:RenumberBlocks ( reactor params / e f i l n s )
    (if reactor (vlr-remove reactor))
    (if
        (and
            (not *undoflag*)
            (setq s (ssget "_X" *filter*))
        )
        (progn
            (setq n 0)
            (repeat (setq i (sslength s))
                (if (eq *blockname*
                        (AutoLabel:EffectiveName
                            (setq o (vlax-ename->vla-object (setq e (ssname s (setq i (1- i))))))
                        )
                    )
                    (progn
                        (setq e (entnext e)
                              l (entget  e)
                              f nil
                        )
                        (while (and (not f) (eq "ATTRIB" (cdr (assoc 0 l))))
                            (if (eq *blocktag*  (strcase (cdr (assoc 2 l))))
                                (setq f (entmod (subst (cons 1 (itoa (setq n (1+ n)))) (assoc 1 l) l)))
                            )
                            (setq e (entnext e)
                                  l (entget  e)
                            )
                        )
                        (if (and *reactor* (not (member o (vlr-owners *reactor*))))
                            (vlr-owner-add *reactor* o)
                        )
                    )
                )
            )
        )
    )
    (if *reactor*
        (progn (vlr-add *reactor*) (setq *reactor* nil))
    )
    (princ)
)

;;------------------------------------------------------------;;

(defun CommandReactorCallback:UndoCheck ( reactor params )
    (setq *undoflag* (wcmatch (strcase (car params)) "*U,*UNDO"))
    (princ)
)

;;------------------------------------------------------------;;

(defun CommandReactorCallback:BlockInserted ( reactor params / e l )
    (if
        (and
            (not *undoflag*)
            (wcmatch (strcase (car params)) "*I,*INSERT,*EXECUTETOOL")
            (setq e (entlast))
            (setq l (entget e))
            (eq "INSERT" (cdr (assoc 0 l)))
            (= 1 (cdr (assoc 66 l)))
            (eq *blockname* (AutoLabel:EffectiveName (vlax-ename->vla-object e)))
        )
        (AutoLabel:GetNewNumber e)
    )
    (princ)
)

;;------------------------------------------------------------;;

(defun AutoLabel:GetNewNumber ( ent / e f i l n r s )
    (if (setq s (ssget "_X" *filter*))
        (progn
            (setq n 0)
            (repeat (setq i (sslength s))
                (if (eq *blockname*
                        (AutoLabel:Effectivename
                            (vlax-ename->vla-object (ssname s (setq i (1- i))))
                        )
                    )
                    (setq n (1+ n))
                )
            )
            (setq e (entnext ent)
                  l (entget e)
            )
            (while (and (not f) (eq "ATTRIB" (cdr (assoc 0 l))))
                (if (eq *blocktag*  (strcase (cdr (assoc 2 l))))
                    (setq f (entmod (subst (cons 1 (itoa n)) (assoc 1 l) l)))
                )
                (setq e (entnext e)
                      l (entget  e)
                )
            )
            (if
                (setq r
                    (vl-some
                        (function
                            (lambda ( r ) (if (eq *reacdata* (vlr-data r)) r))
                        )
                        (cdar (vlr-reactors :vlr-object-reactor))
                    )
                )
                (vlr-owner-add r (vlax-ename->vla-object ent))
            )                            
        )
    )
    (princ)
)

;;------------------------------------------------------------;;

(defun AutoLabel:EffectiveName ( obj )
    (strcase
        (if (vlax-property-available-p obj 'effectivename)
            (vla-get-effectivename obj)
            (vla-get-name obj)
        )
    )
)

;;------------------------------------------------------------;;
;;                   Loading Expressions                      ;;
;;------------------------------------------------------------;;

(vl-load-com)

(
    (lambda ( / i s l o )
        (setq
            *blocktag*  (strcase *blocktag*)
            *blockname* (strcase *blockname*)
            *reacdata*  "AutoBlockLabel"
            *reactor*   nil
            *undoflag*  nil
        )
        (foreach r1 (vlr-reactors)
            (foreach r2 (cdr r1)
                (if (eq *reacdata* (vlr-data r2)) (vlr-remove r2))
            )
        )
        (if
            (setq s
                (ssget "_X"
                    (setq *filter*
                        (list
                           '(0 . "INSERT")
                           '(66 . 1)
                            (cons 2 (strcat "`*U*," *blockname*))
                            (cons 410 (getvar 'CTAB))
                        )
                    )
                )
            )
            (progn
                (repeat (setq i (sslength s))
                    (if (eq *blockname*
                            (AutoLabel:EffectiveName
                                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                            )
                        )
                        (setq l (cons o l))
                    )
                )
                (CommandReactorCallback:RenumberBlocks nil nil)
                (vlr-object-reactor l *reacdata*
                    (list
                        (cons :vlr-erased   'ObjectReactorCallback:RenumberBlocks)
                        (cons :vlr-copied   'ObjectReactorCallback:RenumberBlocks)
                        (cons :vlr-unerased 'ObjectReactorCallback:RenumberBlocks)
                    )
                )
                (vlr-command-reactor *reacdata*
                    (list
                        (cons :vlr-commandwillstart 'CommandReactorCallback:UndoCheck)
                        (cons :vlr-commandended     'CommandReactorCallback:BlockInserted)
                    )
                )
            )
        )
    )
)

(princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

Таким образом, имеем отличный автонумератор на лиспе, который в случае удаления какого-то одного блока автоматически перенумерует все последующие. В названии блока "ПП-" имеется в виду плита плоская. Num_pp - есть имя блоктега, меняющегося - это и есть последовательная нумерация плит.

Теперь, собственно, вопрос - можно ли, и как этот скрипт довести до ума, и научить его автонумеровать не только блок "ПП-" с его меняющимся хвостом "num_pp", но и несколько блоков другого типа ("ПР-" - плита ребристая, "МУ-" - монолитный участок, ну и т.д.) впридачу? При этом чтобы он продолжал контролировать нумерацию, но уже сразу нескольких типов блоков? Пробовал менять в нем переменные (для начала решил создать два одинаковых лиспа с разной маркировкой плит - в итоге каждый лисп может работать только поочередно, одновременная работа не выходит, приходится загружать каждый по очереди; при установке в автозагрузку работает только один из скриптов, второй отказывается), не вышло - заменив все переменные на *2, где звездочка - это исходная переменная, он вообще перестал работать (почему решил переименовать - справедливо думал, что должны отсутствовать повторяющиеся имена переменных).

Ежели кого сие заинтересовало или может кто помочь - буду рад принять участие в написании скрипта, что-то дельное предложить. Думается мне, что такой скрипт может быть очень полезным для электриков, пожарных при разработке ПСД на системы, да и нашему брату-строителю, ибо маркировка элементов на схемах - дело долгое. Обычной автонумерации в интернете полно, а эта - крайне удобна в использовании.

[Do$]

Лисп этот изначально писался только под один блок, переделать его под несколько - та еще задачка. Но воплне выполнимая.
Самое простое что Вы можете сделать, чтобы он работал с двумя блоками одновременно - нужно создать его копию и:
1. Заменить "ПП-" и "num_pp" на нужные значения.
2. Изменить имена всех переменных, заключенных в звездочки, например: *reacdata* изменить на *reacdata1*
3. Изменить имена всех функций в лиспе. Имена функций идут после defun, например: AutoLabel:EffectiveName заменить на AutoLabel:EffectiveName1
Замену выполнять надо во всем документе. Лучше всего это делать специальными инструментами автозамены, чтобы не пропустить ничего.
Обратите внимание, что *U* вот в этой конструкции "`*U*," не является переменной, это шаблон поиска строки. Так что, чтобы это было нагляднее, замену лучше выполнять в редакторе с подсветкой синтаксиса лиспа. Например, во VLIDE.
После этого, оба лиспа будут работать одновременно, каждый со своим блоком. Соответственно, если блоков не два - таких лиспов понадобится больше.
Ну или кто-то возьмется и сделает одну программу для нескольких блоков...

[DrBerD]

Сообщение от Do$ Лисп этот изначально писался только под один блок, переделать его под несколько - та еще задачка. Но воплне выполнимая. Самое простое что Вы можете сделать, чтобы он работал с двумя блоками одновременно - нужно создать его копию и: 1. Заменить "ПП-" и "num_pp" на нужные значения. 2. Изменить имена всех переменных, заключенных в звездочки, например: *reacdata* изменить на *reacdata1* 3. Изменить имена всех функций в лиспе. Имена функций идут после defun, например: AutoLabel:EffectiveName заменить на AutoLabel:EffectiveName1 Замену выполнять надо во всем документе. Лучше всего это делать специальными инструментами автозамены, чтобы не пропустить ничего. После этого, оба лиспа будут работать одновременно, каждый со своим блоком. Соответственно, если блоков не два - таких лиспов понадобится больше. Ну или кто-то возьмется и сделает одну программу для нескольких блоков...

Следуя логике программирования, сегодня все так и сделал - и получив отрицательный результат, обратился за помощью. Упустил только имена функций. Если такое прокатит, попробую дома сделать - и логично будет менять имена не на *1, а на *pp, pr, mu и т.д. - как-то логически чтобы понятно было, конкретные имена для конкретных переменных. Вообще в планах собрать десятка полтора-два таких лиспов (коли не удастся в один слить), свои типы линий новые, профили и т.д., и сделать из всего этого инсталлятор обычный, *.exe, чтобы раскидать по компьютерам коллег, ибо каждого обучать премудростям, которые постигаю сам - "та еще задачка".

Кстати, заключенные в звездочки переменные - и все? Их внутренние переменные нуждаются в замене? Я их пробовал тоже все менять.

[Do$]

Сообщение от DrBerD Упустил только имена функций.

Это очень важно. Если этого не сделать, то при загрузке второго лиспа функции первого будут переопределяться и первый лисп перестанет правильно работать.

Сообщение от DrBerD Кстати, заключенные в звездочки переменные - и все? Их внутренние переменные нуждаются в замене? Я их пробовал тоже все менять.

Внутренние менять не надо, они локальные и за пределы функций не выходят, если все правильно программист сделал. Здесь вроде программист сделал все по уму.

Сообщение от DrBerD Вообще в планах собрать десятка полтора-два таких лиспов (коли не удастся в один слить), свои типы линий новые, профили и т.д., и сделать из всего этого инсталлятор обычный, *.exe, чтобы раскидать по компьютерам коллег, ибо каждого обучать премудростям, которые постигаю сам - "та еще задачка".

Если по хорошему, то этим должен заниматься КАД-Менеджер или, как у нас их называют, специалист по САПР.

[DrBerD]

Сообщение от Do$ Если по хорошему, то этим должен заниматься КАД-Менеджер или, как у нас их называют, специалист по САПР.

Ну, у нас хоть и контора гос. уровня, но... гос. уровня)) так что новые веяния вношу я, да и то слабо приживается все. Смех смехом, но у нас даже слоями почти не пользуются.

----- добавлено через ~7 мин. -----

Сообщение от Do$ Внутренние менять не надо, они локальные и за пределы функций не выходят, если все правильно программист сделал. Здесь вроде программист сделал все по уму.

Следуя этой логике... можно тогда повторять скрипт в одном файле, с переименованными функциями и глобальными переменными, и он должен работать. Я правильно понял?

[Do$]

При необходимости, можно и так. Но запутаетесь потом, лучше этого не делать.

[DrBerD]

Работает! Измененные индексы "pr" теперь легко заменяются автозаменой.

[tanjakrasnich]

Помогите пожалуйста разобраться с этой программой, ссылка на которую приведена вначале, я не очень разбираюсь в LISP. Можно ли как-нибудь задать начальное значение не просто цифрой, а что-то вроде кода оборудования например, с буквами и цифрами, и чтобы дальше только цифры нумеровались. То ли я как-то не так что-то делаю, а может она вообще так не работает. Подскажите кто-нибудь пожалуйста.

[Nike]

tanjakrasnich, http://dwg.ru/dnl/1929

[tanjakrasnich]

а при удалении какого-то блока они тоже сами пересчитываются?

[Nike]

tanjakrasnich, неть.

[Сергей812]

tanjakrasnich Есть программки, автоматически нумерующие блоки в том порядке, в котором эти блоки "нанизаны" на заданную полилинию - шлейф, кабель. Попробуйте в этом направлении поискать.