Тема: LISP, DCL. Выбор всех объектов на указанном слое
Вариант 1.
;******************* sel_lay.lsp *****************************************
; Выбор всех объектов на слое выбранного объекта.
; Автор Владимир Громов.
;
(defun C:SEL_LAY ( / echo sen ent lay ss len da)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(princ "\n Определение слоя по объекту.")
(setq sen (entsel " Выберите нужный объект: "))
(if sen
(progn
(setq ent (entget (car sen)))
(setq lay (cdr (assoc 8 ent)))
(setvar "CLAYER" lay)
(setq ss (ssget "_X" (list (cons 8 lay))))
(setq len (sslength ss))
(sssetfirst nil ss)
(initget 6 "Да Нет Yes No _ Yes No")
(setq da (getkword "\n Отключить остальные слои? [Да/Нет] <Да>: "))
(if (or (= da "Yes") (= da nil))
(progn
(vl-cmdf "_-LAYER" "_OF" "*" "_Y" "")
(vl-cmdf "_-LAYER" "_ON" LAY "")
)); if da
(sssetfirst ss ss)
(princ "\n Слой: ") (princ lay)
(princ " Количество объектов = ") (princ len)
)
(princ "\n Объект не выбран!")
); if sen
(setvar "cmdecho" echo)
(princ)
)Возможный макрос для кнопки или пункта меню:
^C^C^P(if (not C:SEL_LAY) (load "sel_lay")) SEL_LAY
---------------------------------------------------------------------------------
Вариант 2.
;******************* lay_sel.lsp *****************************************
; Выбор всех объектов на указанном слое.
; Предполагается, что все слои в рисунке включены,
; не заморожены и не заблокированы.
; Автор Владимир Громов.
;
(defun C:LAY_SEL ( / echo lay ss len da)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (not C:SETCL) (load "ddcl"))
(C:SETCL)
(setq lay (getvar "CLAYER"))
(setq ss (ssget "_X" (list (cons 8 lay))))
(setq len (sslength ss))
(sssetfirst nil ss)
(initget 6 "Да Нет Yes No _ Yes No")
(setq da (getkword "\n Отключить остальные слои? [Да/Нет] <Да>: "))
(if (or (= da "Yes") (= da nil))
(progn
(vl-cmdf "_-LAYER" "_OF" "*" "_Y" "")
(vl-cmdf "_-LAYER" "_ON" LAY "")
)); if da
(sssetfirst ss ss)
(princ "\n Слой: ") (princ lay)
(princ " Количество объектов = ") (princ len)
(setvar "cmdecho" echo)
(princ)
)Для работы этой программы необходимы еще 2 файла:
;************* 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;
}Возможный макрос для кнопки или пункта меню:
^C^C^P(if (not C:LAY_SEL) (load "lay_sel")) LAY_SEL
Далее можно, например, скопировать выбранные объекты в буфер обмена для вставки в другой рисунок.
