CAD-страница НП | Статьи | English | Download

Танцы панелей

(из книги "AutoLISP и Visual LISP в среде AutoCAD")

Функционирование панелей инструментов похоже на функционирование меню (например, падающих), однако работать из LISP-программы с панелями труднее, потому что приходится в обязательном порядке применять технологию ActiveX.
В данной статье приводится пример решения в системе AutoCAD 2006/2007 следующих задач:

создание новой панели в оперативной памяти;
добавление кнопок к панели;
настройка изображения на кнопке панели;
настройка функциональности кнопки (задание макроса и подсказок);
перемещение панели на экране;
удаление панели.

В рассматриваемом далее исходном коде панель сначала будет создана и оформлена. Затем эта панель будет передвигаться по экрану с заданной скоростью и по заданному маршруту. По окончании "танца" панель будет удалена. Для версий AutoCAD, отличных от 2006/2007, алгоритм будет тот же, но в коде будут небольшие изменения (соответствующие примечания будут сделаны).
В листинге 1 показан текст функции cr_tb, предназначенной для создания новой панели в заданной группе адаптации (для версии 2005 и ниже - заданной группе меню). В процессе работы необходимо проанализировать правильность имени группы, правильность имени панели (нет ли уже с таким именем).

Листинг 1. Файл cr_tb.lsp
 ; Приложение 5\cr_tb.lsp
; Н.Н.Полещук, 2006 г.
; В книге: Н.Н.Полещук, П.В.Лоскутов
;"AutoLISP и Visual LISP в среде AutoCAD"
; (издательство "БХВ-Петербург", 2006)
; http://poleshchuk.spb.ru/cad/

(defun cr_tb (g_name t_name l_names l_helps l_macros l_icons cx cy nrows / wbOK mgs mg tbs tb i tbitem)
(vl-load-com)
(setq mgs (vla-get-MenuGroups (vlax-get-acad-object)))
(if (= (type g_name) 'STR)

(setq wbOK (if mgs T nil)))
(if wbOK
(progn
; При отсутствии группы: Automation Error. Invalid argument XXX in Item
(setq mg (vl-catch-all-apply 'vla-Item (list mgs g_name)))
(if (/= (type mg) 'VLA-OBJECT)
(progn
(setq wbOK nil)
(princ "\nНеверно имя группы адаптации (меню). ")
);progn
);if
);progn
);if
; Имя группы правильное
; Проверяем, нет ли уже одноименной панели
(if wbOK
(progn
(if (= (type t_name) 'STR)
(progn
(setq tbs (vla-get-Toolbars mg))
; При отсутствии панели: Automation Error. Invalid argument XXX in Item
(setq tb (vl-catch-all-apply 'vla-Item (list tbs t_name)))
(if (not (vl-catch-all-error-p tb))
(progn
(setq wbOK nil); повтор имени
(princ "\nПовтор имени панели. ")
);progn
);if
);progn
(progn
(setq wbOK nil)
(princ "\nНеверно имя панели. ")
);progn
);if
);progn
);if
; Имя новой панели верно. Создаем новую панель
(if wbOK
(progn
(setq tb (vla-Add tbs t_name))
(if tb
(progn
; Добавление кнопок и установка пиктограмм
; Нужны проверки типов данных аргументов-списков
(setq i -1)
(repeat (length l_names)
(setq i (1+ i))
(setq tbitem (vla-AddToolbarButton tb i (nth i l_names) (nth i l_helps) (nth i l_macros))); кнопка i
(vla-SetBitmaps tbitem (nth i l_icons) (nth i l_icons))
);repeat
; Координаты панели на экране и количество рядов
(vla-Float tb cx cy nrows)
(princ (strcat "\nПанель " t_name " создана в группе " g_name ". "))
(setq g_tb tb); сохранение в глобальной переменной для дальнейшего использования
(vlr-beep-reaction); звуковой сигнал
);progn
(princ (strcat "\nПанель с именем " t_name " уже существует в группе " g_name ". "))
);if
);progn
);if
; Освобождение памяти, занятой ненужными VLA-объектами
(mapcar (function (lambda (x) (if (and x (not (vlax-object-released-p x))) (vlax-release-object x)))) (list mgs mg tbs tbitem))
(princ)
);defun cr_tb

Функция cr_tb имеет следующие аргументы:

g_name - имя группы адаптации (меню), в которую добавляется панель (должно быть строкой с именем одной из групп, загруженных в память). Например: "ACAD";
t_name - имя создаваемой панели (должно быть строкой и отличаться от всех имен панелей, уже существующих в группе g_name). Например: "Dancing Queen";
l_names - список из строк с названиями кнопок в новой панели (название выводится в желтом прямоугольнике при подведении курсора к кнопке). Например: '("Dance1" "Dance2" "Dance3" "Dance4" "Dance5");
l_helps - список из строк с подробными подсказками, выводимыми в строке состояния при подведении курсора к кнопке. Например: '("Подсказка 1" "Подсказка 2" "Подсказка 3" "Подсказка 4" "Подсказка 5");
l_macros - список из строк с макросами, которые выполняются при щелчке по кнопке. Например: '("(alert\"New\") " "(alert\"Open\") " "(alert\"Save\") " "(alert\"SaveAs\") " "(alert\"Print\") "). Каждый макрос заканчивается пробелом (аналогом нажатия клавиши Enter);
l_icons - список из строк с именами ресурсов пиктограмм, которые связываются с кнопками панели. Ресурсы должны быть иконками из DLL-файла ресурсов AutoCAD или bmp-файлами. Например: '("RCDATA_16_NEW" "RCDATA_16_OPEN" "RCDATA_16_SAVE" "RCDATA_16_SAVE" "RCDATA_16_PRINT") - имена ресурсов для кнопок New, Open, Save и Print из панели Standard (Стандартная). В версиях 2004 и 2005 такие же имена ресурсов. В версии 2002 вместо префикса RCDATA_ используется префикс ICON_;
cx - горизонтальная координата начального положения панели (неотрицательное целое число);
cy - вертикальная координата начального положения панели (неотрицательное целое число);
nrows ≈ количество рядов в начальном положении (целое число от 1 до количества кнопок в панели).
Первое, что делает функция cr_tb - проверяет правильность имени группы, в которой необходимо создать панель. Имя группы передается через первый аргумент. Программа проверяет его тип на строковый, а затем проверяет, что группа с таким именем существует в текущем рисунке (она должна быть членом семейства MenuGroups). При проверке используется важная функция vl-catch-all-apply. В случае возникновения прерывания из-за ошибки, связанной с тем, что указанная группа не существует, эта функция возвращает не VLA-объект группы, а объект типа VL-CATCH-ALL-APPLY-ERROR.
Для проверки применяется такая конструкция:
(setq tb (vl-catch-all-apply 'vla-Item (list mgs g_name)))
После выполнения этого выражения можно спокойно проанализировать тип результата, не прерывая работу программы.
Аналогичная проверка осуществляется для аргумента t_name, который должен быть строкой. Но здесь функция vl-catch-all-apply применяется в обратном режиме: если ошибки нет, то это означает, что в семействе Toolbars уже есть панель с именем t_name, что для нас недопустимо!
После проверки правильности имени группы и имени панели инструментов программа переходит к созданию панели. Вначале с помощью метода Add создается VLA-объект пустой панели:
(setq tb (vla-Add tbs t_name))
Затем с помощью метода AddToolbarButton в панель добавляются кнопки, количество которых равно длине списка l_names (обращаем внимание, что для сокращения места в программе отсутствует проверка длин списков l_helps, l_macros и l_icons - если эти списки короче, то программа не сработает; кроме того, надо контролировать, что все элементы списков действительно являются строками).
Далее с помощью метода SetBitmaps к кнопкам привязываются изображения. В примере использованы пиктограммы кнопок панели инструментов Standard (Стандартная). В качестве имен малых и больших кнопок указаны одни и те же имена (это системой допускается). В результате на экране должна появиться панель (на рис.1 показан пример панели Dancing Queen (Танцующая королева) с пятью кнопками).


Рис.1. Панель Dancing Queen

VLA-объект построенной панели запоминаем в глобальной переменной g_tb для передачи в другие функции. Остальные VLA-объекты удаляются с помощью функции vlax-release-object и тем самым освобождается занятая ими память.
Следующая функция move_tb должна перемещать панель из одной точки экрана в другую в заданное количество шагов (слишком быстрое движение неинтересно). Текст функции приведен в листинге 2.

Листинг 2. Файл move_tb.lsp
 ; Приложение 5\move_tb.lsp
; Н.Н.Полещук, 2006 г.
; В книге: Н.Н.Полещук, П.В.Лоскутов
;"AutoLISP и Visual LISP в среде AutoCAD"
; (издательство "БХВ-Петербург", 2006)
; http://poleshchuk.spb.ru/cad/

(defun move_tb (tb x1 y1 x2 y2 ntime / i x y)
(vla-Float tb x1 y1 1)
(setq i 0 x x1 y y1)
(repeat ntime

(setq i (1+ i) x (+ x1 (/ (/ (* i (- x2 x1)) ntime))))
(setq y (+ y1 (/ (/ (* i (- y2 y1)) ntime))))
(vla-put-Left tb x)
(vla-put-Top tb y)
);repeat
(vlr-beep-reaction)
);defun move_tb

Функция move_tb в цикле преобразует панель в один ряд кнопок и пересчитывает положение панели на экране. Аргумент ntime управляет временем, за которое панель пройдет путь между крайними точками. В конце маршрута с помощью функции vlr-beep-reaction выдается звуковой сигнал. Поскольку фоновое окно не успевает перерисовываться, то при движении панели на экране остается шлейф.
Следующая функция dance_tb (листинг 3) двигает панель на экране по маршруту, который задается списком из нескольких точек.

Листинг 3. Файл dance_tb.lsp
; Приложение 5\dance_tb.lsp
; Н.Н.Полещук, 2006 г.
; В книге: Н.Н.Полещук, П.В.Лоскутов
;"AutoLISP и Visual LISP в среде AutoCAD"
; (издательство "БХВ-Петербург", 2006)
; http://poleshchuk.spb.ru/cad/

(defun dance_tb (tb plist ntime / wbOK p x0 y0 x1 y1)
(if (and (listp plist)(> (vl-list-length plist) 0))

(progn
(setq plist (vl-remove-if-not 'test plist))
(setq x0 (vla-get-Left tb) y0 (vla-get-Top tb))
(while plist
(setq x1 (caar plist) y1 (cadar plist))
(move_tb tb x0 y0 x1 y1 ntime)
(setq x0 x1 y0 y1 plist (cdr plist))
);while plist
);progn
);if
);defun dance_tb
; Проверяем список на 2 элемента и оба числа (numberp)
; Вспомогательная функция
(defun test (p / wbOK)
(setq wbOK (if (and (listp p) (= (vl-list-length p) 2)) T nil))
(if wbOK
(setq wbOK (and (numberp (car p)) (numberp (cadr p))))
);if
);defun test (T только для правильного списка)

В функции dance_tb сначала проверяется правильность списка plist и из него удаляются неправильные элементы (не представляющие двумерные точки). После этого многократно применяется функция перемещения move_tb.
Для получения полной картины осталось только привести программный код, который выполняет танец от начала и до конца (листинг 4).

Листинг 4. Файл show.lsp
; Приложение 5\show.lsp
; Параметры новой панели
(setq gn "ACAD" tn "Dancing Queen")
(setq ln (list "Dance1" "Dance2" "Dance3" "Dance4" "Dance5"))
(setq lh (list "Подсказка 1" "Подсказка 2" "Подсказка 3" "Подсказка 4" "Подсказка 5"))
(setq lm (list "(alert\"New\") " "(alert\"Open\") " "(alert\"Save\") " "(alert\"SaveAs\") " "(alert\"Print\") "))
(setq li (list "RCDATA_16_NEW" "RCDATA_16_OPEN" "RCDATA_16_SAVE" "RCDATA_16_SAVE" "RCDATA_16_PRINT"))
(setq k1 200 k2 150 kr 1)
(cr_tb gn tn ln lh lm li k1 k2 kr)
;;; Пример танца
(dance_tb g_tb (list '(100 100) '(500 200) '(0 400)) 10000)
;;; Удаление танцовщицы
(vla-Delete g_tb)
(vlax-release-object g_tb)
(setq g_tb nil)
(princ "\nПанель удалена. Концерт окончен. ")
(princ)

На рис.2 показан "танцевальный момент". Виден след от шлейфа панели. Любопытны изображения "мнимых" панелей, которые появляются в нижней части (объяснить их трудно).


Рис.2. Танцующая панель

Созданную панель можно и не удалять: она удалится при выходе из сеанса работы с системой AutoCAD. Панель существует только в оперативной памяти компьютера (почти что в нашем воображении ...). Но свои задачи она исправно выполнит.
Панели, которые необходимы пользователю постоянно, рекомендуется не создавать динамически, как в рассмотренном нами примере, а загружать в версии 2006/2007 через CUI-файл (в более ранних версиях - через MNU-файл).

CAD-страница НП | Статьи | English | Download