Главная СПДС СПДС. КОД ПРОГРАММЫ (файл LSP).


; Программа 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***************	
    

  при полном или частичном использовании материалов сайта ссылка на источник обязательна ©2002-2012