Тихое выполнение функций и команд

Автор: | Дата: 29 Ноябрь 2010 · 9 коммент. 

Последнее время на форумах стали появляться вопросы типа "как добиться тихого выполнения функций Lisp или команд AutoCAD"?

Как всегда, вариантов выхода из ситуации несколько.
Для собственных функций в принципе достаточно в конце поставить (princ) - результат функции, конечно, будет nil, но зато и в командную строку выводиться ничего не будет. Но и внутри своих функций может потребоваться "тихая" работа. Можно сменить значения системных переменных cmdecho, nomutt и menuecho. Теоретически этого должно хватать, но фактически этого не всегда достаточно. Так, например, выполнение кода

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(defun silence-audit-cmd (/ adoc lst)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (setq
    lst (mapcar (function (lambda (x / res)
                            (setq res (cons (car x) (getvar (car x))))
                            (setvar (car x) (cdr x))
                            res
                            ) ;_ end of lambda
                          ) ;_ end of function
                '(("cmdecho" . 0) ("nomutt" . 1) ("menuecho" . 0))
                ) ;_ end of mapcar
    ) ;_ end of setq
  (command "_.audit" "_y")
  (foreach item lst
    (setvar (car item) (cdr item))
    ) ;_ end of foreach
  (vla-endundomark adoc)
  ) ;_ end of defun

или

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(vl-load-com)

(defun silence-audit-vla (/ adoc lst)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (setq
    lst (mapcar (function (lambda (x / res)
                            (setq res (cons (car x) (getvar (car x))))
                            (setvar (car x) (cdr x))
                            res
                            ) ;_ end of lambda
                          ) ;_ end of function
                '(("cmdecho" . 0) ("nomutt" . 1) ("menuecho" . 0))
                ) ;_ end of mapcar
    ) ;_ end of setq
  (vla-auditinfo adoc :vlax-true)
  (foreach item lst
    (setvar (car item) (cdr item))
    ) ;_ end of foreach
  (vla-endundomark adoc)
  ) ;_ end of defun

Все равно выводит в командную строку результат выполнения.
Некоторые команды и функции lisp и импортированные из arx или .NET-сборок невозможно "заглушить" (пример выше). Но иногда (подчеркиваю - именно иногда!) можно "обойти" такие вещи. Так, например:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun silence-purge-cmd (/ adoc lst)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (setq
    lst (mapcar (function (lambda (x / res)
                            (setq res (cons (car x) (getvar (car x))))
                            (setvar (car x) (cdr x))
                            res
                            ) ;_ end of lambda
                          ) ;_ end of function
                '(("cmdecho" . 0) ("nomutt" . 1) ("menuecho" . 0))
                ) ;_ end of mapcar
    ) ;_ end of setq
  (command "_.-purge" "_a" "" "_n")
  (command "_.-purge" "_r" "" "_n")
  (foreach item lst
    (setvar (car item) (cdr item))
    ) ;_ end of foreach
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

по идее должно сработать нормально, но в AutoCAD 2008 Eng не работает - все равно в командную строку выводится отчет о работе. Обходим:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(vl-load-com)

(defun silence-purge-vla (/)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (repeat 3 (vla-purgeall adoc))
  (vlax-for app (vla-get-registeredapplications adoc)
    (vl-catch-all-apply
      (function (lambda () (vla-delete app)))
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

В AutoCAD 2008 все хорошо и тихо. В BricsCAD, говорят, такое уже не прокатывает. Значит, обходим и это (если, конечно, требуется):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(vl-load-com)

(defun silence-purge-vla (/ adoc)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (foreach tbl '("blocks"            "linetypes"
                 "textstyles"        "dimstyles"
                 "registeredapplications"
                 "layers"
                 )
    (vlax-for item (vlax-get adoc tbl)
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete item)
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vlax-for
    ) ;_ end of foreach
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Конечно, надо добавить обработку стилей таблиц, стилей мультилиний и т.п. - т.е. вещей, доступ к которым осуществляется через словари.

Размещено в Код LISP, Функции LISP · Метки: ,



Комментарии

Есть 9 коммент. к “Тихое выполнение функций и команд”
  1. TararykovDG пишет:
    26 Апрель 2012 в 13:32

    Алексей, здравствуй! Спасибо за пример тихого выполнения команд, мне пригодился для замены _-purge’мета, в четвертом коде (или втором снизу) одна лишняя скобка:
    (repeat 3 (vla-purgeall adoc))
    ) ;_ end of repeat

  2. Кулик Алексей aka kpblc пишет:
    26 Апрель 2012 в 13:45

    Ага, спасибо, исправляю :)

  3. TararykovDG пишет:
    26 Апрель 2012 в 13:50

    И еще есть вопрос, в последнем коде используется функция vlax-get, которая, наряду с vlax-put является не документированной, и как пишет Н. Полещук: “Возможно, в очередной версии AutoCAD они окажутся изъятыми…
    …использование этих функций не может быть рекомендовано ввиду неясности их дальнейшей судьбы”

  4. TararykovDG пишет:
    26 Апрель 2012 в 15:53

    Алексей, ну уж извини, снова есть вопросы.
    Во-первых, последний код при обработке блоков, удалит все листы (*PaperSpace0 и т.д.), кроме того, который является текущим (ну да это легко исправить, добавив проверку IsLayout для каждого элемента из коллекции блоков).
    Во-вторых, не удалит вложенные блоки (как это делает (vl-cmdf "_.-purge" "_Block" "*" "_No")), которые до удаления их родительских блоков не являлись неиспользуемыми, а после могли таковыми стать. И здесь самое интересное даже повторное прохождение по коллекции блоков и применение к нем vla-delete не удаляет такие блоки, хотя в утилите очистки чертежа блоки появляются.

  5. Кулик Алексей aka kpblc пишет:
    3 Май 2012 в 22:59

    Насчет vlax-get и vlax-put. В данном случае их можно безболезненно заменить на vlax-get-property -эффект будет тот же самый.
    И касательно вложенных блоков. Как-то у меня не получилось повторить подобную ситуацию. Несколько проходов по коллекции блоков удалили вложенные. Конечно, там можно добавить массу проверок, но я подобным просто не заморачивался. Если надо, могу попробовать на днях что-нибудь нарисовать.

  6. TararykovDG пишет:
    16 Июль 2012 в 12:45

    Привет, Алексей. Все это время (с мая) пользовался Твоим кодом с небольшой доработкой (добавил проверку, что текущий блок не *ModelSpace и не *PaperSpace…) для тихого удаления неиспользуемых блоков и слоев. И вот на днях получил, супер облом. Итак, ситуация следующая, если на чертеже присутствуют размеры (а они очень часто присутствуют), то в коллекции блоков появляются блоки с именами *D. Так вот если их попытаться молча удалить, то размеры потом ведут себя очень странно. А именно, при перемещении – отскакивают, при этом если нажать Ctrl+A для выделения всех элементов, то ручки у отскочивших размеров, находятся в нужном месте, а графически они куда-то смещаются. А если попытаться скопировать их через буфер обмена, то они не вставляются, а вставляется предыдущее содержимое буфера обмена. Протестировал на ACAD 2008 и ACAD 2012. Если не трудно протестируй у себя так ли это или это только мой “баг”, во всяком случае сейчас делаю так.
    [cc lang="lisp"]
    (defun purge-blocks(adoc / )
    (vlax-for blk (vla-get-Blocks adoc)
    (if (and (equal (vla-get-IsLayout blk) :vlax-false)
    (not (wcmatch (vla-get-name blk) "`*D*"))
    )
    (vl-catch-all-apply
    (function
    (lambda()
    (vla-delete blk)
    ); _end of lambda
    ) ; _end of function
    ) ; _end of if
    ) ; _end of if
    ) ; _end of while
    ); _end of defun
    [/cc]

  7. Кулик Алексей aka kpblc пишет:
    16 Июль 2012 в 13:09

    Доброго. Я гонял на 2006, 2008, 2009, 2010 и 2012. Подобного вроде бы не замечалось.Странно...
    Для гарантии я бы добавил еще одну проверку - на объекты таблиц (они в блоках *T):
    [cc lang="cadlisp"](vl-load-com)

    (defun purge-blocks (adoc /)
    (vlax-for blk (vla-get-blocks (cond (adoc)
    (t (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of cond
    ) ;_ end of vla-get-blocks
    (if (and (equal (vla-get-islayout blk) :vlax-false)
    (equal (vla-get-isxref blk) :vlax-false)
    (not (wcmatch (vla-get-name blk) "*D*,*T*"))
    ) ;_ end of and
    (vl-catch-all-apply
    (function
    (lambda ()
    (vla-delete blk)
    ) ; _end of lambda
    ) ; _end of function
    ) ;_ end of vl-catch-all-apply
    ) ;_ end of if
    ) ;_ end of vlax-for
    ) ;_ end of defun[/cc]

    P.S. Обновил код - добавил проверку на внешние ссылки :)

  8. TararykovDG пишет:
    16 Июль 2012 в 13:20

    Алексей, спасибо, раз у Тебя подобного не наблюдается, посмотрю у себя еще раз повнимательней, в чем может быть причина.

  9. Кулик Алексей aka kpblc пишет:
    16 Июль 2012 в 13:24

    То, что у меня не наблюдается, не означает, что подобное нельзя словить :) Это ж известный закон - у разработчика всегда и все работает :)
    Так что я бы не убирал, наверное, подобные проверки. Как говорится, "от греха" ;)

Поделитесь своим мнением


Я не робот.