 |
|
|
; Программа ABC_PRGNAME и другие ее файлы может быть использована любыми пользователями без ограничений.
;
; Ссылка на источник при использовании фрагментов программы - желательна.
;
;* ABC_PRGNAME.LSP(FAS) [Основная программа]
;* команда Acad: ABC_PRGNAME
;*
;* Отрисовка рамок (овальных, прямоугольных и сглаженных) вокруг текста или набора текстов.
;* Отрисовка текста с заданными свойствами и рамки к нему.
;* Рамки, созданные ранее для текстов, при переопределении автоматически удаляются.
;* Удаление рамок, созданных программой.
;*
;* Это пример организации и оформления программ по стандарту KAI.
;* Переименуйте имена файлов и функций при необходимости.
;*
;* ** Acad 15,16,17
;* ** (c) Косов А.И., г.Магадан, тел.(413-2)65-05-10д http://geol-dh.narod.ru/ ai_kosov@mail.ru
;* ** 2003 г
;*
;----------------------------------
; С О С Т А В П Р О Г Р А М М Ы
;----------------------------------
;
; ABC_PRGNAME.LSP или FAS - файл программы
; ABC_PRGNAME.DCL - описание диалоговых окон
; ABC_PRGNAME.SET - задание начальных параметров и список сообщений программы на русском и английском языках
; ABC_PRGNAME.BMP - иконка программы (для меню)
; ABC_FUNCTION.LSP или FAS - файл общих функций к комплексу программ ABC*
;
;------------------------------------------------
; О Г Р А Н И Ч Е Н И Я В П Р О Г Р А М М Е
;------------------------------------------------
; Только для объектов TEXT.
; Параллельность текстов текущей системе координат не проверяется.
; Для таких текстов отрисованные рамки будут неверны.
; При перемещении нельзя пользоваться привязками и вообще никакого другого ввода, кроме указания точки мышкой
; Значения объектов МTEXT, взятых из объекта при заполнении поля 'Текст' будут верными,
; если они не превышают 250 знаков (иначе - только хвост значения текста)
;
;---------------------------------------------
; Функция удаления рамок, созданных программой
;---------------------------------------------
(defun ERASE_BOXES ( / selset i en xdlst hand_old en_old sumdel)
; сохранение объектной привязки
(setvar "OSMODE" glob_osm-old)
; подсказка пользователю
(princ (strcat "\n" (ABC_MES 24) ":"));24="Select set of texts to ERASE boxes around"
; выбор пользователем (отбираются только TEXT, остальные объекты игнорируются)
(setq selset (ssget '((0 . "TEXT")))
);setq selset
;сохранение режима привязки
(setq glob_osm-old (getvar "OSMODE"))
;и назначение нужного режима привязки
(setvar "OSMODE" 0)
; если набор не пустой
(if (and selset (> (sslength selset) 0))
(progn
(setq i 0 sumdel 0)
; вокруг каждого текста из набора рисуем рамку
(while (setq en (ssname selset i))
; если уже была отрисована рамка (т.е. есть расширенные данные у текста)
(if (setq xdlst (cdr (cadr (assoc -3 (entget en (list glob_appname))))))
(progn
; старая метка полилинии
(setq hand_old (cdr (assoc 1005 xdlst)))
; если объект еще существует (рамка не была удалена)
(if (setq en_old (handent hand_old))
(if (entget en_old)
(progn
; размыкаем слой (вдруг замкнутый
(setq glob_locklay_str (ABC_UNLOCK_LAYER (cdr (assoc 8 (entget en_old))) glob_locklay_str))
; удаляем старую рамку
(entdel en_old)
; добавляем единицу к счетчику
(setq sumdel (1+ sumdel))
)
)
)
)
)
(setq i (1+ i))
);while
(if (/= sumdel 0)
(princ (strcat "\n" (ABC_MES 25) ": " ;25="Number of boxes erased"
(itoa sumdel) ". " ))
)
)
)
);end of ****** ERASE_BOXES *******
;
;-------------------------------------------------------------------------------------------------
; Функция извлечения значения текста из объекта чертежа и добавления (замены) к текущему значению)
;-------------------------------------------------------------------------------------------------
(defun GET_TEXT_VALUE (txtvalue add_mode / newvalue flag message2user en_pt en txt)
;txtvalue - текущее значение текста в окне задания параметров
;add_mode - режим добавления-замены текста значением из объекта T(добавлять), Nil(заменять)
(setq flag T)
(while flag
;возврат прежнего режима привязки
(setvar "OSMODE" glob_osm-old)
;вывод сообщения для пользователя
(setq message2user (strcat "\n" (ABC_MES 6) ": "));6="Select text"
;выбор объекта пользователем
(setq en_pt (entsel message2user))
;сохранение режима привязки
(setq glob_osm-old (getvar "OSMODE"))
;и назначение нужного режима привязки
(setvar "OSMODE" 0)
(if en_pt ;объект был выбран пользователем
(progn
(setq en (car en_pt)); имя объекта
; проверка на допустимость типа объекта
(if (ABC_CHECK_OBTYPE en '("TEXT" "MTEXT"))
(progn
; берем значение из текста чертежа
(setq txt (cdr (assoc 1 (entget en))))
(if (/= txt "")
(if add_mode ; добавлять или заменять?
(setq newvalue (strcat txtvalue txt)); добавлять значение объекта к текущему значению поля
(setq newvalue txt); заменять текущее значение поля на значение объекта
)
)
(setq flag nil); выход из цикла выбора объекта
)
)
)
(progn
(setq flag nil); выход из цикла выбора объекта
(setq newvalue txtvalue); оставляем прежнее значение текста в поле
)
)
);while
; возврат значения поля (старое, замененное или добавленное)
newvalue
);end of ******** GET_TEXT_VALUE ********
;
;---------------------------------------------
; Функция отрисовки текста и рамки вокруг него
;---------------------------------------------
(defun CREATE_TEXT (pt / ht rot)
;pt - точка вставки текста
; при включенном флажке - берем значение высоты текста из поля окна параметров
; (иначе - значение перед входом в программу)
(if (= abc_prgname_ht1 1)
(setq ht abc_prgname_ht)
(setq ht glob_curr_ht)
)
; при включенном флажке - берем значение угла поворота текста из поля окна параметров (иначе - 0)
(if (= abc_prgname_rot1 1)
(setq rot (rtos abc_prgname_rot))
(setq rot "0.0")
)
; если значение текста задано, отрисовываем текст. Остальные свойства текста устанавливаются
; в конце функции DCL_SETTINGS
(if (/= abc_prgname_value "")
(progn
(if (or (= abc_prgname_just "_LEFT") (= abc_prgname_just1 0))
(command "._TEXT" pt ht rot abc_prgname_value)
(command "._TEXT" "_J" abc_prgname_just pt ht rot abc_prgname_value)
)
(setq en (entlast))
; отрисовка рамки вокруг текста
(DRAW_BOX en)
)
)
);end of ***** CREATE_TEXT *******
;
;-------------------------------------
; Функция отрисовки векторов подсветки
;-------------------------------------
(defun DRAW_VECTORS (pt_1st pt_end pt_list flag_close / i pt_list_new next_pt current_pt ang dis pt1 pt2)
;pt_1st - точка на середине диагонали рамки вокруг оригинального текста
;pt_end - точка текущего положения курсора
;pt_list - список точек (не менее 2-х), по координатам которых рисуются вектора
;flag_close - флаг отрисовки вектора от начальной к конечной точке (T или nil)
(setq i 0)
; обходим все точки списка, пока следуещей точки не будет
(while (setq next_pt (nth (1+ i) pt_list))
(setq current_pt (nth i pt_list))
; направление от середины текста до текущего положения курсора
(setq ang (angle pt_1st pt_end))
; то же расстояние
(setq dis (distance pt_1st pt_end))
; новое положение точек рамки
(setq pt1 (polar current_pt ang dis))
(setq pt2 (polar next_pt ang dis))
; формирование списка новых точек рамки
(if (= i 0)
(setq pt_list_new (append (list pt1) (list pt2) '()))
(setq pt_list_new (append pt_list_new (list pt2)))
)
; подсветка вектора
(grdraw pt1 pt2 -1 1)
(setq i (1+ i))
);while
(if flag_close
(progn
; если контур замкнут, подсветка от первой до последней точки списка
(grdraw (car pt_list_new) (last pt_list_new) -1 1)
)
)
;возвращает список с новыми координатами рамки
pt_list_new
);end of ******* DRAW_VECTORS *******
;
;-----------------------------------------------
; Функция добавления расширенных данных к тексту
;-----------------------------------------------
(defun APPEND_XDATA (reg appname en hand / exdata flag)
;reg - флаг регистрации программ (T или nil)
;appname - имя зарегистрированной программы
;en - имя объекта (текст)
;hand - метка объекта (полилинии рамки)
(if (and reg hand appname en)
(progn
; размыкаем слой (вдруг замкнутый)
(setq glob_locklay_str (ABC_UNLOCK_LAYER (cdr (assoc 8 (entget en))) glob_locklay_str))
; добавление метки полилинии в расширенные данные текста
(setq exdata (append (list (list -3 (list appname ;имя зарегистр.программы
(cons 1005 hand) ;handle
))))
)
; обновление объекта текст
(setq flag (entmod (append (entget en) exdata)))
)
(progn
(princ (strcat "\n" "EXTENDED Data NOT ATTACHED to text."));практически невероятно, на всякий случай
(setq flag nil)
)
)
flag
);end of ******* APPEND_XDATA ********
;
;-------------------------------------------------------------------------------------
; Функция перемещения последних выбранных и/или отрисованных объектов (текста и рамки)
;-------------------------------------------------------------------------------------
(defun MOVE_LAST ( / last_pt box_points next_pt read_type read_val)
; если существует набор (из текста и полилинии)
(if (and glob_moveset (> (sslength glob_moveset) 0))
(progn
(setq glob_en (ssname glob_moveset 0))
(redraw glob_en 3)
;создание временных переменных
(setq last_pt glob_pt_last)
(setq box_points glob_box_points)
; продолжаем до тех пор пока пользователь ведет курсор по экрану и не задал точку вставки
(while last_pt
; считываем значение функции grread (параметр и точка) и выделяем тип и саму точку
(setq next_pt (grread 1)
read_type (car next_pt)
read_val (cadr next_pt))
(cond ((not (or (= read_type 5) (= read_type 3))); выход если нажато все кроме левой кнопки мыши
(progn
(setq last_pt_select nil)
(setq last_pt nil)
))
((= read_type 3);точка задана
(progn
; отрисовываем векторы прямоугольника на новом месте и считываем список точек
; нового положение рамки
(setq box_points (DRAW_VECTORS glob_pt_last read_val box_points T))
(setq last_pt_select read_val)
(setq last_pt nil)
))
(T ; курсор продолжает перемещаться (read_type=5)
(progn
(redraw)
; отрисовываем векторы прямоугольника на новом месте
(DRAW_VECTORS glob_pt_last read_val box_points T)
(setq last_pt read_val)
))
);cond
);while
; новая точка была задана
(if last_pt_select
(progn
; перемещаем текст и рамку
(command "._MOVE" glob_moveset "" glob_pt_last last_pt_select)
; задаем новое значение середины рамки и списку точек рамки
(setq glob_pt_last last_pt_select)
(setq glob_box_points box_points)
)
(progn
(princ (strcat "\n" (ABC_MES 7)));7="Second point not spesified."
)
)
(redraw glob_en 4)
)
(princ (strcat "\n" (ABC_MES 8)));8="Nothing to move."
)
);end of ******** MOVE_LAST ********
;
;---------------------------------------------------------------------------------
; Функция задания набора объектов TEXT и отрисовки вокруг текстов из набора рамок
;---------------------------------------------------------------------------------
(defun DO_SELECTION_SET ( / selset i en )
; сохранение объектной привязки
(setvar "OSMODE" glob_osm-old)
; подсказка пользователю
(princ (strcat "\n" (ABC_MES 9) ":"));9="Select set of texts to draw boxes around"
; выбор пользователем (отбираются только TEXT, остальные объекты игнорируются)
(setq selset (ssget '((0 . "TEXT")))
);setq selset
;сохранение режима привязки
(setq glob_osm-old (getvar "OSMODE"))
;и назначение нужного режима привязки
(setvar "OSMODE" 0)
; пример выбора TEXT или MTEXT
;;; (setq selset (ssget '((-4 . "открывающаяся_угловая_скобкаOR")
;;; (0 . "TEXT")
;;; (0 . "MTEXT")
;;; (-4 . "ORзакрывающаяся_угловая_скобка")
;;; )
;;; ));setq selset
; если набор не пустой
(if (and selset (> (sslength selset) 0))
(progn
(setq i 0)
; вокруг каждого текста из набора рисуем рамку
(while (setq en (ssname selset i))
(DRAW_BOX en)
(setq i (1+ i))
);while
(princ (strcat "\n" (ABC_MES 10) ": " ;10="Number of boxes created"
(itoa (sslength selset)) ". " ))
)
)
);end of ******** DO_SELECTION_SET *****
;
;---------------------------------------
; Функция отрисовки рамки вокруг текста
;---------------------------------------
(defun DRAW_BOX (en / enlist list_text pt1 pt2 length_text distinspt offset0 text_ang height_text offset_box
inspt_text pt1box pt1box pt2box pt3box pt4box hand_new xdlst hand_old en_old xdlst_new
exdata max_radius1 max_radius2 radius)
;en - имя объекта
(setq enlist (entget en))
; список из двух точек нижняя левая и верхняя правая (границы текста, горизонтального в точке 0,0)
(setq list_text (textbox enlist))
(if list_text
(progn
(setq pt1 (car list_text) ; нижний левый угол горизонтального текста с началом в 0,0,0
pt2 (cadr list_text)); правый верхний угол
; длина текста
(setq length_text (- (car pt2) (car pt1)))
; расстояние от 0,0 до действительной границы текста (для наклонных текстов)
(setq distinspt (distance '(0 0) (list (car pt1) 0)))
; в какую сторону направлено смещение действительной границы текста
(if (> (car pt1) 0)
(setq offset0 "+")
(setq offset0 "-")
)
; угол разворота текста
(if (not (setq text_ang (cdr (assoc 50 enlist)))); если не присутствует в списке объекта
(setq text_ang 0.0)
)
; высота текста
(setq height_text (cdr (assoc 40 enlist)))
; действительное смещение рамки
(setq offset_box (* height_text abc_prgname_offset))
; точка вставки текста (левая)
(setq inspt_text (cdr (assoc 10 enlist)))
; преобразование координат текста в текущую систему координат
(setq inspt_text (trans inspt_text en 1))
; действительное начало текста (для наклонных текстов)
(setq pt1box (polar inspt_text
(if (= offset0 "+")
text_ang
(+ text_ang PI)
)
distinspt))
; точки рамки вокруг текста с заданным смещением
(if (and (= abc_prgname_mode 2) (= abc_prgname_rad 0.0))
(progn
; для прямоугольника
(setq pt1box (polar pt1box (+ text_ang (* PI 1.25)) (/ offset_box (cos (* PI 0.25))))); левая нижняя точка
(setq pt2box (polar pt1box (+ text_ang (* PI 0.5)) (+ height_text offset_box offset_box))); левая верхняя
(setq pt3box (polar pt2box text_ang (+ length_text offset_box offset_box))); правая верхняя
(setq pt4box (polar pt3box (- text_ang (* PI 0.5)) (+ height_text offset_box offset_box))); правая нижняя
)
(progn
; максимально возможный радиус
(setq max_radius1 (/ (+ height_text offset_box offset_box) 2.0))
(setq offset_boxleft 0.0)
(if (= abc_prgname_mode 1)
(setq radius max_radius1) ; для овалов
(progn
; для скругленного прямоугольника
(setq radius abc_prgname_rad)
(if (> radius max_radius1)
(setq radius max_radius1)
)
(if (>= radius offset_box)
(setq offset_boxleft 0.0)
(setq offset_boxleft (- offset_box radius))
)
)
)
(setq pt1box (polar pt1box (- text_ang (* PI 0.5)) offset_box))
(setq pt1box (polar pt1box (+ text_ang PI) (+ radius offset_boxleft)))
(setq pt2box (polar pt1box (+ text_ang (* PI 0.5)) (+ height_text offset_box offset_box))); левая верхняя
(setq pt3box (polar pt2box text_ang (+ length_text (+ radius offset_boxleft) (+ radius offset_boxleft))))
(setq pt4box (polar pt3box (- text_ang (* PI 0.5)) (+ height_text offset_box offset_box))); правая нижняя
)
)
; устанавливаем нужное значение слоя для отрисовки рамки
(if (= abc_prgname_boxlayer1 1)
(setvar "CLAYER" abc_prgname_boxlayer)
(setvar "CLAYER" glob_curr_layer)
)
(setvar "CECOLOR" glob_curr_color);
; рисуем рамку на заданном слое
(command "._PLINE" pt1box pt2box pt3box pt4box "_C")
; метка полилинии
(setq hand_new (cdr (assoc 5 (entget (entlast)))))
; далее добавление в расширенные данные текста метки полилинии
; если уже была отрисована рамка (т.е. есть расширенные данные у текста)
(if (setq xdlst (cdr (cadr (assoc -3 (entget en (list glob_appname))))))
(progn
; старая метка полилинии
(setq hand_old (cdr (assoc 1005 xdlst)))
; если объект еще существует (рамка не была удалена)
(if (setq en_old (handent hand_old))
(if (entget en_old)
(progn
; размыкаем слой (вдруг замкнутый
(setq glob_locklay_str (ABC_UNLOCK_LAYER (cdr (assoc 8 (entget en_old))) glob_locklay_str))
; удаляем старую рамку
(entdel en_old)
(princ (strcat "\n" (ABC_MES 11))) ;11="Old textbox erased."
)
)
)
; замещение старой метки на новую в списке
(setq xdlst_new (subst (cons 1005 hand_new) (assoc 1005 xdlst) xdlst))
; формирование нового списка расширенных данных (с меткой рамки)
(setq exdata (append (list glob_appname) xdlst_new))
(setq exdata (append (list -3 exdata)))
; размыкаем слой (вдруг замкнутый
(setq glob_locklay_str (ABC_UNLOCK_LAYER (cdr (assoc 8 (entget en))) glob_locklay_str))
; обновление списка данных текста в базе Acad
(if (entmod (append (entget en) (list exdata)))
(princ (strcat " " (ABC_MES 12)));12="Text xdata updated."
(princ (strcat "\n" "EXTENDED Data NOT ATTACHED to text."));практически невероятно, на всякий случай
)
)
; добавление расширенных данных для текста (рамка создается впервые для этого текста)
(APPEND_XDATA glob_reg_appname glob_appname en hand_new)
)
; формирование глобальных переменных для возможности дальнейшего перемещения текста и полилинии
; на новое место по опции MoveLast
; центр рамки (середина диагонали)
(setq glob_pt_last (polar pt1box (angle pt1box pt3box) (/ (distance pt1box pt3box) 2.0)))
; список точек рамки
(setq glob_box_points (list pt1box pt2box pt3box pt4box))
; набор из текста и полинилии рамки
(setq glob_moveset (ssadd en))
(setq glob_moveset (ssadd (entlast) glob_moveset))
; формирований углов закругления рамки
; половины длин сторон рамки
(if (= abc_prgname_mode 1);режим отрисовки овальной рамки
(progn
; выполняем скругление углов
(command "._FILLET" "_R" radius)
(command "._FILLET" "_P" (entlast))
)
; Если радиус 0 - ничего не выполняем, иначе - скругляем углы заданным радиусом
(if (/= abc_prgname_rad 0.0)
(progn
; выполняем скругление углов
(command "._FILLET" "_R" radius)
(command "._FILLET" "_P" (entlast))
)
)
)
)
(alert (strcat "\n" "ACAD can't calculate length of string."));практически невероятно, на всякий случай
)
);end of ****** DRAW_BOX *********
;
;-------------------------------------------------------------
; функции блокирования полей DCL для выбора пользователем
; (при данном положении флажков, переключателй и радиокнопок)
;-------------------------------------------------------------
(defun MODE_TILE_DCL ()
(if (/= glob_mode "CREATE TEXT")
; для режима отрисовки рамок для существующих текстов все поля свойств текста будут погашены
; (станут невозможными для выбора)
(progn ;выключено
(mode_tile "abc_prgname_layer1" 1) ;выключено
(mode_tile "abc_prgname_style1" 1)
(mode_tile "abc_prgname_ht1" 1)
(mode_tile "abc_prgname_rot1" 1)
(mode_tile "abc_prgname_just1" 1)
(mode_tile "abc_prgname_color1" 1)
(mode_tile "abc_prgname_value" 1)
(mode_tile "abc_prgname_layer" 1)
(mode_tile "abc_prgname_style" 1)
(mode_tile "abc_prgname_ht" 1)
(mode_tile "abc_prgname_rot" 1)
(mode_tile "abc_prgname_just" 1)
(mode_tile "abc_prgname_color" 1)
(mode_tile "abc_prgname_newvalue" 1) ;далее кнопки
(mode_tile "abc_prgname_newvalue_add" 1)
(mode_tile "abc_prgname_newpoint" 1)
)
(progn ; в зависимости от значений флажков выключаются соответствующие поля в диалоговом окне
(if (= abc_prgname_layer1 1); слой текста
(mode_tile "abc_prgname_layer" 0) ;включено
(mode_tile "abc_prgname_layer" 1) ;выключено
)
(if (= abc_prgname_style1 1); стиль текста
(mode_tile "abc_prgname_style" 0)
(mode_tile "abc_prgname_style" 1)
)
(if (= abc_prgname_ht1 1); высота текста
(mode_tile "abc_prgname_ht" 0)
(mode_tile "abc_prgname_ht" 1)
)
(if (= abc_prgname_rot1 1); угол поворота
(mode_tile "abc_prgname_rot" 0)
(mode_tile "abc_prgname_rot" 1)
)
(if (= abc_prgname_just1 1); выравнивание текста
(mode_tile "abc_prgname_just" 0)
(mode_tile "abc_prgname_just" 1)
)
(if (= abc_prgname_color1 1); цвет текста
(progn
(mode_tile "abc_prgname_color" 0)
(mode_tile "abc_prgname_colortxt" 0)
)
(progn
(mode_tile "abc_prgname_color" 1)
(mode_tile "abc_prgname_colortxt" 1)
)
)
)
)
(if (= abc_prgname_mode 2); радиус закругления (в зависимости от радиокнопок режима закругления рамки)
(mode_tile "abc_prgname_rad" 0) ;включено
(mode_tile "abc_prgname_rad" 1) ;выключено
)
(if (= abc_prgname_boxlayer1 1); слой для рамки
(mode_tile "abc_prgname_boxlayer" 0)
(mode_tile "abc_prgname_boxlayer" 1)
)
); end of ******** MODE_TILE_DCL ********
;
;------------------------------------------------------------------------------------------
; функция анализа ввода пользователя в DCL файле (и вывода сообщения об недопустимом вводе)
; (сведения об ошибках ввода можно выводить и в tyle "error")
;------------------------------------------------------------------------------------------
(defun IF_DCL_ERROR ( / )
(setq errstr "ERROR!")
; проверка на допустимость значения высоты текста
(if (<= abc_prgname_ht 0)
(progn
(setq errstr (strcat "\n" (ABC_MES 13) " " ;13="Height of text must exceed null."
(ABC_MES) " 2.5"));14="Set to"
(setq abc_prgname_ht 2.5)
(set_tile "abc_prgname_ht" (rtos abc_prgname_ht 2 2)); обновление поля высоты текста
)
)
; проверка на допустимость значения радиуса закругления
(if (< abc_prgname_rad 0)
(progn
(setq errstr (strcat "\n" (ABC_MES 15) " " ;15="Radius must be positive."
(ABC_MES) " 2.5"));14="Set to"
(setq abc_prgname_rad 0.0)
(set_tile "abc_prgname_rad" (rtos abc_prgname_rad 2 2)); обновление поля радиуса закругления
)
)
; проверка на допустимость значения смещения рамки от текста
(if (< abc_prgname_offset 0)
(progn
(setq errstr (strcat "\n" (ABC_MES 16) " " ;16="Box offset must be positive."
(ABC_MES) " 2.5"));14="Set to"
(setq abc_prgname_offset 0.0)
(set_tile "abc_prgname_rad" (rtos abc_prgname_offset 2 2)); обновление поля смещения рамки
)
)
; вывод сообщения об ошибке (складываются все ошибки сразу)
(if (/= errstr "ERROR!")
(alert errstr)
)
);end of ********* IF_DCL_ERROR *******
;
;---------------------------------------------------------------------
; Функция задания значения текстового поля по номеру цвета в DCL файле
;---------------------------------------------------------------------
(defun SET_TILECOLOR_TEXT ()
(set_tile "abc_prgname_colortxt" (strcat "[ " (ABC_DIG2STR_COLOR abc_prgname_color) " ]")); цвет Acad в строку
);end of ** SET_TILETEXT **
;
;-------------------------------------------------------------------------
; Функция вывода окна задания параметров и обработки действий пользователя
;-------------------------------------------------------------------------
(defun DCL_SETTINGS ( / number idx )
; загрузка диалогового окна на требуемом языке
(if (= abc_language 1)
(if (not (new_dialog "settings_ABC_PRGNAME" dcl-id "" c-dcl)) (EXIT))
(if (not (new_dialog "settings_ABC_PRGNAME_RUS" dcl-id "" c-dcl)) (EXIT))
)
; блокирование полей в DCL в зависимости от положения переключателей и радиокнопок
(MODE_TILE_DCL)
; задание выбора режима отрисовки рамки вокруг текста
(cond ((= abc_prgname_mode 1)
(set_tile "abc_prgname_mode1" "1"); овальная
)
((= abc_prgname_mode 2)
(set_tile "abc_prgname_mode2" "1"); с заданным радиусом, при R=0 - прямоугольная
)
);cond
; установка значения радиуса
(set_tile "abc_prgname_rad" (rtos abc_prgname_rad 2 2))
; установка смещения рамки
(set_tile "abc_prgname_offset" (rtos abc_prgname_offset 2 2))
; отрисовывать рамку на нужном слое?
(set_tile "abc_prgname_boxlayer1" (itoa abc_prgname_boxlayer1))
; заполнение списка слоев рамки
(start_list "abc_prgname_boxlayer")
(mapcar 'add_list glob_laylist)
(end_list)
; если текущее имя слоя не присутствует в списке (например, удалили слой из чертежа),
; то приравниваем его значение к первому по списку
(if (not (member abc_prgname_boxlayer glob_laylist))
(setq abc_prgname_boxlayer (car glob_laylist))
)
; порядковый номер слоя в списке
(setq idx (ABC_GETINDEX abc_prgname_boxlayer glob_laylist))
; устанавливаем значения поля
(set_tile "abc_prgname_boxlayer" (itoa idx))
; далее установка значений полей для свойств текста
(set_tile "abc_prgname_value" abc_prgname_value) ; значение текста
(set_tile "abc_prgname_layer1" (itoa abc_prgname_layer1)) ; далее флажки
(set_tile "abc_prgname_style1" (itoa abc_prgname_style1))
(set_tile "abc_prgname_ht1" (itoa abc_prgname_ht1))
(set_tile "abc_prgname_rot1" (itoa abc_prgname_rot1))
(set_tile "abc_prgname_just1" (itoa abc_prgname_just1))
(set_tile "abc_prgname_color1" (itoa abc_prgname_color1))
; заполнение списка слоев для отрисовки теста
(start_list "abc_prgname_layer")
(mapcar 'add_list glob_laylist)
(end_list)
; если текущее имя слоя не присутствует в списке (например, удалили слой из чертежа),
; то приравниваем его значение к первому по списку
(if (not (member abc_prgname_layer glob_laylist))
(setq abc_prgname_layer (car glob_laylist))
)
(setq idx (ABC_GETINDEX abc_prgname_layer glob_laylist))
(set_tile "abc_prgname_layer" (itoa idx))
; заполнение списка стилей текста с переменной высотой
(start_list "abc_prgname_style")
(mapcar 'add_list glob_stylelist)
(end_list)
; если текущее имя стиля не присутствует в списке (например, удалили стиль из чертежа),
; то приравниваем его значение к первому по списку
(if (not (member abc_prgname_style glob_stylelist))
(setq abc_prgname_style (car glob_stylelist))
)
; порядковый номер стиля в списке
(setq idx (ABC_GETINDEX abc_prgname_style glob_stylelist))
(set_tile "abc_prgname_style" (itoa idx))
; заполниние списка выравнивания текста
(start_list "abc_prgname_just")
(mapcar 'add_list prgname_just);список определен в SET файле
(end_list)
(set_tile "abc_prgname_just" (itoa (ABC_GETINDEX abc_prgname_just prgname_just)))
; высота текста
(set_tile "abc_prgname_ht" (rtos abc_prgname_ht 2 2))
; угол поворота текста
(set_tile "abc_prgname_rot" (rtos abc_prgname_rot 2 2))
; назначение текстового поля по номеру цвета (расшифровка цвета)
(SET_TILECOLOR_TEXT)
; заполнение цветного квадрата (кнопки) [ 1-вызов окна, 2-цвет, 3-имя tile в DCL ]
(setq abc_prgname_color (ABC_FILL_COLOR "NO" abc_prgname_color "abc_prgname_color"))
; текстовое поле внизу окна
(set_tile "error" (ABC_MES 5));5="Cancel - break program."
;;;
; обработка событий для соответствующих полей (tiles) окна задания параметров (DCL)
; свойства рамки
(action_tile "abc_prgname_mode1" "(setq abc_prgname_mode 1)(MODE_TILE_DCL)")
(action_tile "abc_prgname_mode2" "(setq abc_prgname_mode 2)(MODE_TILE_DCL)")
(action_tile "abc_prgname_rad" "(setq abc_prgname_rad (atof $value))(IF_DCL_ERROR)")
(action_tile "abc_prgname_offset" "(setq abc_prgname_offset (atof $value))(IF_DCL_ERROR)")
(action_tile "abc_prgname_boxlayer1" "(setq abc_prgname_boxlayer1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_boxlayer" "(setq abc_prgname_boxlayer (nth (atoi $value) glob_laylist))")
; свойства текста (при отрисовке)
; флажки
(action_tile "abc_prgname_layer1" "(setq abc_prgname_layer1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_style1" "(setq abc_prgname_style1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_ht1" "(setq abc_prgname_ht1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_rot1" "(setq abc_prgname_rot1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_just1" "(setq abc_prgname_just1 (atoi $value))(MODE_TILE_DCL)")
(action_tile "abc_prgname_color1" "(setq abc_prgname_color1 (atoi $value))(MODE_TILE_DCL)")
; поля
(action_tile "abc_prgname_value" "(setq abc_prgname_value $value)")
(action_tile "abc_prgname_layer" "(setq abc_prgname_layer (nth (atoi $value) glob_laylist))")
(action_tile "abc_prgname_style" "(setq abc_prgname_style (nth (atoi $value) glob_stylelist))")
(action_tile "abc_prgname_ht" "(setq abc_prgname_ht (atof $value))(IF_DCL_ERROR)")
(action_tile "abc_prgname_rot" "(setq abc_prgname_rot (atof $value))")
(action_tile "abc_prgname_just" "(setq abc_prgname_just (nth (atoi $value) prgname_just))")
(action_tile "abc_prgname_color" "(setq abc_prgname_color
(ABC_FILL_COLOR \"YES\" abc_prgname_color \"abc_prgname_color\"))(SET_TILECOLOR_TEXT)") ; обработка нажатий кнопок
(action_tile "accept" "(done_dialog 1)"); выход по кнопке OK
(action_tile "cancel" "(done_dialog 0)"); выход по кнопке Cancel
(action_tile "help" "(ABC_HELP \"ABC_PRGNAME\")"); вызов Help
(action_tile "abc_prgname_newpoint" "(done_dialog 2)"); выход по кнопке [Изменить точку вставки текста]
(action_tile "abc_prgname_newvalue" "(done_dialog 3)"); Замена на значение текста из чертежа
(action_tile "abc_prgname_newvalue_add" "(done_dialog 4)"); Добавление значения текста из чертежа
(setq e (start_dialog)); e = выход по cancel=0, по OK=1 и т.д.
(if (= e 0)
(setq e nil)
)
(if (= e 1)
; если OK - установка соответствующих системных переменных и размыкание слоев
; (с формированием списка слоев, разомкнутых программой)
(if (= glob_mode "CREATE TEXT")
(progn
(if (= abc_prgname_style1 1)
(setvar "TEXTSTYLE" abc_prgname_style)
(setvar "TEXTSTYLE" glob_curr_style)
)
(if (= abc_prgname_color1 1)
(setvar "CECOLOR" (ABC_DIG2STR_COLOR abc_prgname_color)); преобразование номера цвета в строку
(setvar "CECOLOR" glob_curr_color)
)
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_layer glob_locklay_str))
(if (= abc_prgname_layer1 1)
(setvar "CLAYER" abc_prgname_layer)
(setvar "CLAYER" glob_curr_layer)
)
)
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_boxlayer glob_locklay_str))
)
)
(setq e e)
);end of ** DCL_SETTINGS ***
;-------------------------------------------------------------
; функция обработки прерываний (нажатие Esc, ошибок программы)
;-------------------------------------------------------------
(defun M_ERROR (ert);ert = строка, выдаваемая Acad при ошибке в коде или прерывании программы пользователем
; фильтрация нажатия пользователем Esc
(if (not (member ert '("Function cancelled" "console break" "quit / exit abort")))
(princ (strcat "\nERROR in program ABC_PRGNAME: " ert));печать ошибки в текстовое окно, если не ESC
)
; возврат системных переменных и/или другие возвраты
(RESTORE_ON_EXIT)
(prin1)
); end of ** M_ERROR **
;-----------------------------------------------------------------------------------------
; функция возврата системных переменных в прежнее состояние, и другие необходимые возвраты
;-----------------------------------------------------------------------------------------
(defun RESTORE_ON_EXIT ()
; Возврат управления обработки ошибок прежней функции
(setq *error* old-error)
; обновление экрана (при необходимости)
(redraw)
; снятие подсветки примитива, если он был подсвечен (glob_en = имя примитива по типу )
(if glob_en (redraw glob_en 4))
; выгрузить файл диалога, если был загружен
(if dcl-id (unload_dialog dcl-id))
; возврат замкнутых слоев, которые были отомкнуты программой, в прежнее положение
(if (/= glob_locklay_str "") (command "._-LAYER" "_LOCK" glob_locklay_str ""))
;;; ; закрыть файл, если он был открыт (df=дескриптор файла, выдаваемый при открытии файла)
;;; (if df (close df))
; Возврат состояния системных переменных
(ABC_RESTORE_SVAR saved_svar_list)
(if glob_osm-old (setvar "OSMODE" glob_osm-old));лучше отдельно
; задать конечную метку для отмены действий программы (в начале программы см. команду _UNDO _BEGIN)
(command "._UNDO" "_END")
(if cmd-old (setvar "CMDECHO" cmd-old));лучше отдельно в последнюю очередь
; освобождение памяти от функций программы
(setq CREATE_TEXT nil DRAW_VECTORS nil APPEND_XDATA nil MOVE_LAST nil
DO_SELECTION_SET nil DRAW_BOX nil MODE_TILE_DCL nil IF_DCL_ERROR nil
SET_TILECOLOR_TEXT nil DCL_SETTINGS nil
M_ERROR nil RESTORE_ON_EXIT nil)
;и тихий выход
(prin1)
) ;end of ********** RESTORE_ON_EXIT **********
;
; *********************************************************
;
; НАЧАЛО ОСНОВНОЙ ФУНКЦИИ (КОМАНДЫ) ** ABC_PRGNAME **
;
; *********************************************************
;
(defun ABC_PRGNAME ( / cmd-old saved_svar_list old-error dcl-id c-dcl loop massage2user c e en add
; глобальные переменные
glob_osm-old glob_mode glob_curr_ht glob_curr_layer glob_curr_color glob_curr_style
glob_moveset glob_pt_last glob_box_points glob_appname glob_reg_appname glob_laylist
glob_stylelist glob_locklay_str glob_en)
;сохранение системной переменной
(setq cmd-old (getvar "CMDECHO"))
;запрет на вывод эха команд Acad в текстовое окно
(setvar "CMDECHO" 0)
;установить метку для отмены работы программы (при необходимости)
(command "._UNDO" "_BEGIN"); или (command "._UNDO" "_Mark")
;загрузка пользовательских функций, если они есть. Можно без флага, загружать функции
; каждый раз при вызове программы (это надежнее, но тратится время).
;флаг - глобальная переменная!!!
(if (not abc_function_flag) ;флаг должен быть определен в конце файла функций (Т or nil)
(progn
(if (or (findfile "ABC_FUNCTION.fas") (findfile "ABC_FUNCTION.lsp"))
(progn
(princ "\nLoading functions from ABC_FUNCTION...")
;загрузка функций, общих для комплекса программ (неважно, какое расширение, если они найдены)
(load "ABC_FUNCTION")
(princ "OK\n")
)
(progn
;печать сообщения и выход из программы, если файл не нейден.
(alert "ABC_FUNCTION. Function file not found.
\n\nCancel program.")
(EXIT)
)
)
)
)
; загрузка параметров программы (или других данных, по типу)
; у меня в этом файле, как правило, находятся:
; функция ABC_PRGNAME_SETUP c параметрами программы по умолчанию, которые пользователь может поменять
; и список сообщений программы на 2-х языках
(if (findfile "ABC_PRGNAME.SET");несмотря на расширение SET - этот файл является файлом типа LSP!!!
(progn
(princ (strcat "\nLoading parameters from ABC_PRGNAME.SET..."))
(load "ABC_PRGNAME.SET"); загружаются параметры, если файл найден
(princ (strcat "OK\n"))
)
(progn
;печать сообщения и выход из программы, если файл не нейден.
(alert "ABC_PRGNAME.SET. Parameters file not found.
\n\nCancel program.")
(EXIT)
)
)
;если обязательные для исполнения программы файлы не находятся, выполнение программы прерывается
;задействование клавиши F1 для вызова контекстной справки по данной программе
;(в качестве параметра - индекс в WinHelp-файле, обычно-имя программы)
(if (findfile "ABC_HELP.HLP")
;параметры: определенная в программе команда Acad, WinHelp файл, индекс в нем
(setfunhelp (strcat "C:" "ABC_PRGNAME") "ABC_HELP" "ABC_PRGNAME")
;сообщение, если файл не найден, можно и alert
(princ (strcat "\nABC_HELP.hlp." " " "Help file not found." " "))
)
;сохранение системных переменных, изменяемых в программе ("CMDECHO" и "OSMODE" лучше обрабатывать отдельно)
(setq saved_svar_list (ABC_SAVE_SVAR '("BLIPMODE"
;"PLINEWID"
;"CELTYPE"
"CLAYER"
"CECOLOR"
"TEXTSTYLE"
"TEXTSIZE"
"DIMZIN";и т.д.
)))
(setq glob_curr_layer (getvar "CLAYER"))
(setq glob_curr_style (getvar "TEXTSTYLE"))
(setq glob_curr_color (getvar "CECOLOR"))
(setq glob_curr_ht (getvar "TEXTSIZE"))
;сохранение объектной привязки "OSMODE"
;лично меня раздражает, что если я в процессе работы программы поменял OSNAP,
;а после завершения работы программы, оно опять старое, лучше сохранять его при каждом ожидании ввода.
(setq glob_osm-old (getvar "OSMODE"))
; сохранение текущей и назначение пользовательской функции обработки ошибок
(setq old-error *error* ; сохранение текущей
*error* M_ERROR ; назначение пользовательской
)
;вызов функции для записи в LOG файл даты вызова программы
; (просто для анализа, какие программы чаще используются)
(ABC_LOGPROG "ABC_PRGNAME" "\t");имя программы и разделитель между данными в файле (табуляция)
;вызов функции задания параметров программы по умолчанию (см. файл "ABC_PRGNAME.SET")
(ABC_PRGNAME_SETUP)
;инициализация нужных переменных
(setq abc_prgname_value "")
;загрузка параметров диалоговых окон программы (DCL-файла)
(if (findfile "ABC_PRGNAME.DCL")
(setq dcl-id (load_dialog "ABC_PRGNAME")); dcl-id - дескриптор файла DCL
(progn
(alert "ABC_PRGNAME.DCL. Dialog file not found.
\n\nCancel program.")
(EXIT)
)
)
; формирование данных для окна задания параметров:
; список слоев чертежа по алфавиту в верхнем регистре. (не замороженные и не Xref)
(if (not (setq glob_laylist (ABC_LAYER_LIST (+ 1 2 16 32))))
(progn
(alert (strcat (ABC_MES 17) ;17="Thaw one of layer before start program."
"\n" (ABC_MES 18))) ;18="Cancel program."
(EXIT); прерывание программы
)
)
; список стилей чертежа по алфавиту в верхнем регистре. (только с переменной высотой)
(if (not (setq glob_stylelist (ABC_TSTYLE_LIST )))
(progn
(alert (strcat (ABC_MES 19) ;19="No styles with nonzero height."
"\n" (ABC_MES 18))) ;18="Cancel program."
(EXIT); прерывание программы
)
)
;установка нужных системных переменных через фукнцию, значения задавать явно, не через переменную
;("OSMODE" лучше обрабатывать отдельно)
(ABC_RESTORE_SVAR '(("BLIPMODE" 0)
("DIMZIN" 8);убирать незначащие нули
;и т.д.
))
;или явно
(setvar "DIMZIN" 8);убирать незначащие нули при выводе чисел в строку
(setq c-dcl '(-1 -1)) ;координаты для окна параметров (вначале по центру)
;прочие проверки и назначения параметров (защита от "дурака"), например:
;если стиля, заданного в параметрах по умолчанию нет, задается текущий стиль текста
(if (not (tblsearch "STYLE" abc_prgname_style))
(setq abc_prgname_style (strcase (getvar "TEXTSTYLE")))
)
;если имени слоя, заданного в параметрах по умолчанию нет, задается текущий слой
(if (not (tblsearch "LAYER" abc_prgname_layer))
(setq abc_prgname_layer (strcase (getvar "CLAYER")))
)
(if (not (tblsearch "LAYER" abc_prgname_boxlayer))
(setq abc_prgname_boxlayer (strcase (getvar "CLAYER")))
)
;если цвет не в пределах 0-256 устанавливаем по слою
(if (or (< abc_prgname_color 0) (> abc_prgname_color 256))
(setq abc_prgname_color 256)
)
;если высота текста менее 0 устанавливаем по умолчанию 2.5
(if (<= abc_prgname_ht 0)
(setq abc_prgname_ht 2.5)
)
;размыкание слоев и формирование строки-списка для их последующего восстановления
(setq glob_locklay_str "")
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_boxlayer glob_locklay_str))
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_layer glob_locklay_str))
;установка значений по умолчанию
(if (= glob_mode "CREATE TEXT")
(progn
(setvar "TEXTSTYLE" abc_prgname_style)
(setvar "CECOLOR" (ABC_DIG2STR_COLOR abc_prgname_color)); преобразование номера цвета в строку
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_layer glob_locklay_str))
)
)
;регистрация имени программы (для последующего добавления расширенных данных к объекту)
(setq glob_appname "ABC_PRGNAME")
(setq glob_reg_appname (ABC_REGISTER_APP glob_appname))
;вывод имени программы, ее краткое наименование и др. необходимые данные (например, идентификатор автора)
(princ (strcat "\n(C)ABC. C:ABC_PRGNAME. " (ABC_MES 0) ;0="Drawing text and/or boxes around text"
))
;вывод главных текущих параметров программы
(princ (strcat "\n" (ABC_MES 1) ": " ;1="Current parameters"
(if (= abc_prgname_mode 1)
(strcat (ABC_MES 3) " = " (ABC_MES 20) ", ");3="Type" 20="Slotes"
(strcat (ABC_MES 3) " = " (ABC_MES 21) ", " ;3="Type" 21="Rectangle"
(ABC_MES 4) " = " (rtos abc_prgname_rad 2 3) ", ") ;4="Radius"
)
(ABC_MES 2) " = " abc_prgname_boxlayer ;2="Layer"
))
(setq loop T)
(while loop
; сохранение объектной привязки (вообще желательно при всех вызовах функции
; для пользовательского ввода типа GET... или ENTSEL)
(setvar "OSMODE" glob_osm-old)
(if (= glob_mode "CREATE TEXT")
(progn
;вывод сообщения для пользователя
(setq message2user (strcat "\n[" glob_mode "] " (ABC_MES 22) ;22="Specify insertion point of text or"
" [SS/MoveLast/Settings/EraseBoxes/Help]" ": "))
;определение допустимого пользовательского ввода для последующей функции get...
(initget "Settings SS MoveLast EraseBoxes Help")
;задание точки ввода (или другой GET функции) или опции программы
(setq c (getpoint message2user))
)
(progn
;вывод сообщения для пользователя
(setq message2user (strcat "\n" (ABC_MES 23);23="Select text or"
" [Create/SS/MoveLast/Settings/EraseBoxes/Help]" ": "))
;определение допустимого пользовательского ввода для последующей функции get...
(initget "Settings Create SS MoveLast EraseBoxes Help")
;задание точки ввода (или другой GET функции) или опции программы
(setq c (entsel message2user))
)
)
;сохранение режима привязки
(setq glob_osm-old (getvar "OSMODE"))
;и назначение нужного режима привязки
(setvar "OSMODE" 0)
;установка значений по умолчанию для режима создания текста
(if (= glob_mode "CREATE TEXT")
(progn
(setvar "TEXTSTYLE" abc_prgname_style)
(setvar "CECOLOR" (ABC_DIG2STR_COLOR abc_prgname_color)); преобразование номера цвета в строку
(setq glob_locklay_str (ABC_UNLOCK_LAYER abc_prgname_layer glob_locklay_str))
)
)
;обратотка пользовательского ввода
(cond ; установка параметров программы
((= c "Settings"); введен символ S(s) или введено Settings
(progn
(setq e (DCL_SETTINGS))
(if (not e)
(EXIT)
)
))
; отрисовка рамок для набора объектов
((= c "SS"); введены символы SS
(progn
(DO_SELECTION_SET)
))
; создание текста и отрисовка рамки к нему
((= c "Create"); введен символ C(c) или введено Create
(progn
; переход в режим создания текста с рамкой
(setq glob_mode "CREATE TEXT")
))
; удаление рамок для текстов
((= c "EraseBoxes"); введен символ E(e) или введено EraseBox
(progn
; переход в режим создания текста с рамкой
(ERASE_BOXES)
))
; перемещение последнего созданного или указанного текста и рамки к нему
((= c "MoveLast"); введен символ M(m) или введено MoveLast
(progn
(MOVE_LAST)
))
; вызов справки к программе
((= c "Help"); введен символ H(h) или введено Help
(progn
(ABC_HELP "ABC_PRGNAME");индекс вызова справки к программе в help файле
))
;;; ((= c "Undo"); введен символ U(u) или введено Undo
;;; (progn
;;; ;(ВЫЗОВ НЕОБХОДИМОЙ ФУНКЦИИ)
;;; ))
((= (type c) 'LIST);проверка на ввод пользователем точки по функции getpoint (т.е. списка)
(progn
(if (= (length c) 2)
(progn
(setq en (car c));только (без координат точки)
(setq glob_en en)
; подсветить выбранный текст
(redraw glob_en 3)
; проверка на допустимость имени объекта, если выбранный объект не текст,
; выдается сообщение, снова идет выбор объекта
(if (ABC_CHECK_OBTYPE en '("TEXT"))
; Рисовать рамку для текста
(DRAW_BOX en)
)
; снять подсветку
(redraw glob_en 4)
)
(progn
(setq e 3)
(while (or (= e 3) (= e 4))
(setq e (DCL_SETTINGS))
(if (or (= e 3) (= e 4))
(progn
(if (= e 4)
(setq add "T")
(setq add nil)
)
(setq abc_prgname_value (GET_TEXT_VALUE abc_prgname_value add))
)
)
)
(if (not e);нажата кнопка Cancel
(EXIT)
)
(if (= e 1);нажата кнопка OK
(progn
(CREATE_TEXT c)
)
)
;при нажатии кнопки НОВАЯ ТОЧКА - ничего не выполняется.
)
)
))
;во всех остальных случаях (ничего не задано пользователем, допустим,
;нажата правая кнопка мыши или Enter)
(T
(progn
(setq loop nil); нормальный выход из программы
))
);cond
);while loop
;возврат системных переменных и других параметров при норамльном выходе из программы
(RESTORE_ON_EXIT)
;сообщение о нормальном завершении программы (при необходимости)
(princ "\n *End ABC_PRGNAME*")
(prin1);тихий выход
) ;end ******* ABC_PRGNAME ***************
; *********************************************************
;
; ЗАГРУЗКА новой команды Acad ABC_PRGNAME и передача управления основной функции ABC_PRGNAME
;
; *********************************************************
(defun C:ABC_PRGNAME ()
(princ "\nLoading ABC_PRGNAME....")
; если файл программы найден
(if (or (findfile "ABC_PRGNAME.FAS") (findfile "ABC_PRGNAME.LSP"))
(progn
; загрузка программы
(load "ABC_PRGNAME")
(princ "OK")
; передача управления главной функции программы
(ABC_PRGNAME)
; обуление основной функции, команда ABC_PRGNAME остается в памяти!!!!
; И может вызываться в дальнейшем набором с клавиатуры, через алиасы команд, возможен повтор команды.
(setq ABC_PRGNAME nil)
)
(alert " Program ABC_PRGNAME not found. ")
)
(prin1)
) ;end of **************C:ABC_PRGNAME***************
|
|
СПДС. КОД ПРОГРАММЫ (файл LSP).
