Тема: LISP, DCL. Порядок следования заливки (штриховки SOLID)
К написанию этой программы побудила трудность выделения
сплошной заливки в AutoCAD'ах до 2006. К примеру, я имею
план здания с большим количеством объектов и мне надо
заливками выделить специальные зоны: палаты, коридор, ну,
и т.п. Как правило заливка перекрывает все объекты и надо
ее отправить "вниз". Начинаешь "тыркать" ее и никак не попадешь,
все время выбираются объекты, находящиеся "под" заливкой.
А вот если сознательно создать заливку (штриховку SOLID)
на отдельном слое, скажем, с именем "Зеленый", то с помощью этой
программы можно запросто отправить "вниз" все объекты (в данном
случае заливку зеленого цвета) вниз. Программа использует
диалоговое окно выбора слоя. Сама программ выборы и установки
текущего слоя может работать автономно, но она очень урезана
по сравнению с AutoCAD'овской.
Все три файла должны находится на пути доступа к файлам AutoCAD'а.
Для запуска программы порядка следования можно применить такой
макрос для кнопки или пункта меню:
^C^C^P(load "fil_order")
А для запуска автономной программы выбора слоя:
^C^C^P(if (not C:SETCL) (load "ddcl")) SETCL
;******* fil_order.lsp ******************************************
; Порядок следования заливки (штриховки)
; Автор Владимир Громов
;
(apply '(lambda ()
(setvar "cmdecho" 0)
(setq slt (getvar "CLAYER"))
(C:SETCL)
(setq lay (getvar "CLAYER"))
(setq ss1 (ssget "X"
(list (cons 8 lay))
)
)
(if ss1
(progn
(princ "\n Найдено на слое '") (princ lay) (princ "' ") (princ (sslength ss1)) (princ " объектов.")
(initget "В П")
(setq move (getstring "\n Поместить объекты [Впереди всех/Позади всех] <Позади>: "))
(cond
((= move "В") (command "_DRAWORDER" ss1 "" "Е"))
((or (= move "П") (= move "")) (command "_DRAWORDER" ss1 "" "А"))
)
)
(princ "\n На этом слое ничего нет!")
)
(setvar "CLAYER" slt)
(setq lay nil ss1 nil move nil)
(princ)
)
'()
);************* ddcl.lsp ***********************************
; Выбор и установка текущего слоя.
; Работает с диалоговым окном setcl.
;
(defun laylist_act (index)
(setq lay_idx (atoi index))
(setq layname (nth lay_idx sortlist))
(set_tile "list_l" (itoa lay_idx))
(mode_tile "list_l" 3)
)
(defun laindex ( / m n)
(setq n (length sortlist))
(setq m (length (member (getvar "CLAYER") sortlist)))
(- n m)
)
(defun C:SETCL ( / layname)
(setvar "CMDECHO" 0)
(princ "\n Установите текущий слой: \n ")
(setq sortlist nil)
(setq templist (tblnext "LAYER" T))
(while templist
(setq name (cdr (assoc 2 templist)))
(setq sortlist (cons name sortlist))
(setq templist (tblnext "LAYER"))
)
(if (>= (getvar "maxsort") (length sortlist))
(setq sortlist (acad_strlsort sortlist))
(setq sortlist (reverse sortlist))
)
;Загрузка диалогового окна
(setq dcl_id (load_dialog "ddcl"))
(if (not (new_dialog "setcl" dcl_id)) (exit))
(start_list "list_l")
(mapcar 'add_list sortlist)
(end_list)
;Активизация переменных
(set_tile "list_l" (itoa (laindex)))
(mode_tile "list_l" 3)
(action_tile "list_l" "(laylist_act $value)")
(action_tile "accept" "(done_dialog)")
; Взять значения переменных
(start_dialog)
(unload_dialog dcl_id)
(if (not layname) (setq layname (getvar "clayer")))
(setq laylist (tblsearch "layer" layname))
(setq color (cdr (assoc 62 laylist)))
(setq bit_70 (cdr (assoc 70 laylist)))
(if (and (minusp color) (/= bit_70 65) (/= bit_70 68) (/= bit_70 69))
(progn
(princ "\n Указанный слой отключен! Включаю его.")
(command "_LAYER" "_ON" layname "")
))
(if (and (/= bit_70 65) (/= bit_70 68) (/= bit_70 69))
(setvar "CLAYER" layname)
)
(if (= bit_70 65)
(princ "\n Указанный слой заморожен! Разморозьте его.")
)
(if (= bit_70 68)
(princ "\n Указанный слой заблокирован! Разблокируйте его.")
)
(if (= bit_70 69)
(princ "\n Указанный слой заблокирован и заморожен! \n Разблокируйте и разморозьте его.")
)
(princ "\n Текущим установлен слой: ") (princ layname)
(setq sortlist nil laylist nil color nil layname nil templist nil
lay_idx nil n nil m nil)
(princ)
)Следующие строки необходимо сохранить в файле ddcl.dcl
setcl:dialog {
label = "Выбор слоя";
fixed_width = true;
:row {
:list_box {
width = 12;
height = 16;
key = "list_l";
}
}
ok_only;
}
