Макрос фильтра Быстрого выбора (не фильтр в слоях)

(defun c:chl (/ selset item counter)
  (setq    selset    (ssget "_X" '((0 . "TEXT,MTEXT,DIMENSION")))
    counter    0
    ) ;_ end of setq
  (_kpblc-layer-create-or-modify '(("name" . "Текст") ("color" . 3)))
  (_kpblc-layer-create-or-modify '(("name" . "Размеры") ("color" . 1)))
  (while (and selset
          (setq item (ssname selset counter))
          ) ;_ end of and
    (setq counter (1+ counter)
      item      (vlax-ename->vla-object item)
      ) ;_ end of setq
    ;; Назначаем цвет - по слою
    (vla-put-color item acbylayer)
    ;; Назначаем вес линии - по слою
    (vla-put-lineweight item aclnwtbylayer)
    ;; Назначаем тип линии - по слою
    (vla-put-linetype item "ByLayer")
    ;; И теперь собственно переброс примитива на определенный слой:
    (cond
      ((vl-string-search "Dimen" (vla-get-objectname item))
       ;; Объект является одним из вариантов размера, перекидываем его на слой
       ;; "Размеры"
       (vla-put-layer item "Размеры")
       )
      ((vl-string-search "Text" (vla-get-objectname item))
       ;; Объект является одним из вариантов текста - много- либо одно
       ;; строчным. Перекидываем на слой "Текст"
       (vla-put-layer item "Текст")
       )
      ) ;_ end of cond
    ) ;_ end of while
  ) ;_ end of defun
;|=============================================================================
*    Функция создания слоя с указанными настройками или изменения существующего
* слоя. Попутно слой разблокируется, включается и размораживается.
*    Параметры вызова:
*    layer-list    список параметров слоя вида
*        '(("name" . "Размеры")    ; имя создаваемого слоя. nil - Недопустим
*          ("color" . 1)        ; цвет создаваемого слоя. nil -> 7
*          ("lweight" . 0.25)    ; вес линии. nil -> 0.25
*          ("ltype" . "Continuous")    ; тип линии nil -> Continuous
*          ("plot" . 1)        ; печатается или нет слой. 1 - да; 0 - нет
*                    ; nil - печатается.
*    Внимание! Передавать только маленькими буквами! Иначе настройки не будут
* найдены!
*    Примеры вызова:
(_kpblc-layer-create-or-modify '(("name" . "Размеры") ("color" . 1)))
    ; создаст (а при наличии - изменит) слой "Размеры", задав ему цвет 1,
    ; тип линии - continuous, вес линии - 0.25, слой печатается
=============================================================================|;
(defun _kpblc-layer-create-or-modify
       (layer-list / _cmdecho_ _nomutt_ layer_obj layer_name)
  (if (and layer-list            ; список есть
       (assoc "name" layer-list)    ; и в нем есть группа "name"
       ) ;_ end of and
    (progn
      (setq _cmdecho_  (getvar "cmdecho")
        _nomutt_   (getvar "nomutt")
        layer_name (cdr (assoc "name" layer-list))
        ) ;_ end of setq
      (if (not (tblobjname "layer" layer_name))
    (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) layer_name)
;;;    (progn
;;;      (mapcar 'setvar '("cmdecho" "nomutt") '(0 1))
;;;      (command "_.-layer" "_make" layer_name "")
;;;      (mapcar 'setvar '("cmdecho" "nomutt") (list _cmdecho_ _nomutt_))
;;;      ) ;_ end of progn
    ) ;_ end of if
      (setq layer_obj (vlax-ename->vla-object (tblobjname "layer" layer_name)))
      (if (assoc "color" layer-list)
    (vla-put-color layer_obj (cdr (assoc "color" layer-list)))
    (vla-put-color layer_obj 7)
    ) ;_ end of if
      (if (assoc "lweight" layer-list)
    (vla-put-lineweight
      layer_obj
      (* (cdr (assoc "lweight" layer-list)) 100)
      ) ;_ end of vla-put-LineWeight
    (vla-put-lineweight layer_obj 25)
    ) ;_ end of if
      (if (assoc "ltype" layer-list)
    (progn
      (if (not (tblobjname "ltype" (cdr (assoc "ltype" layer-list))))
        ;; линия не загружена
        (_kpblc-linetype-load (cdr (assoc "ltype" layer-list)) nil)
        ) ;_ end of if
      ;; теперь линия загружена и ее можно назначать на слой
      (vla-put-linetype layer_obj (cdr (assoc "ltype" layer-list)))
      ) ;_ end of progn
    (vla-put-linetype layer_obj "continuous")
    ) ;_ end of if
      (if (assoc "plot" layer-list)
    (if (= (cdr (assoc "plot" layer-list)) 0)
      (vla-put-plottable layer_obj :vlax-false)
      ) ;_ end of if
    (vla-put-plottable layer_obj :vlax-true)
    ) ;_ end of if
      ;; На самом деле все, что ниже, можно сделать через замену одного
      ;; DXF-кода в описании слоя, но иногда это приводит к ошибкам.
      ;; Использование vla-функций ошибок не вызывает.
      (vla-put-layeron layer_obj :vlax-true)
      (vla-put-lock layer_obj :vlax-false)
      (vla-put-freeze layer_obj :vlax-false)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
* https://www.caduser.ru/forum/topic22816.html
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается - он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq    ltype_list '(("center" . "осевая")
             ("center2" . "осевая2")
             ("hidden" . "скрытая")
             ("hidden2" . "скрытая2")
             )
    ltype-name (strcase ltype-name t)
    ) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-load
              (list
                (vlax-get-property
                  (vla-get-activedocument (vlax-get-acad-object))
                  'linetypes
                  ) ;_ end of vlax-get-property
                ltype_normal
                ltype-file
                ) ;_ end of list
              ) ;_ end of vl-catch-all-apply
            ) ;_ end of vl-catch-all-error-p
              ) ;_ end of not
      ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun