Тема: LISP. Аналог Isolate objects (ADT) для AutoCAD

;|=============================================================================
*    Скрытие выбранных объектов / невыбранных объектов / показ всех объектов.
* Сделано в качестве попытки создания аналога ADT-шной команды Isolate objects.
* Работает только в активном пространстве.
*    Параметры вызова:
*    bit    что делать. 0 - показать все; 1 - скрыть выделенные; 2 - скрыть
*        все, кроме выделенных
*    Примеры вызова:
(kpblc-objects-hide 0)    ; Показать все объекты
(kpblc-objects-hide 1)    ; Скрыть выделенные объекты
(kpblc-objects-hide 2)    ; Скрыть все, кроме выделенных
=============================================================================|;
(defun kpblc-objects-hide (bit / selset selset_all msg item)
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (cond
    ((= bit 1) (setq msg "Скрыть выделенные объекты"))
    ((= bit 2) (setq msg "Скрыть кроме выделенных"))
    ) ;_ end of cond
  (if (= bit 0)
    (progn
      (setq selset (ssget "_A"))
      (while (and selset (> (sslength selset) 0))
        (setq item (ssname selset 0))
        (ssdel item selset)
        (vla-put-visible (vlax-ename->vla-object item) :vlax-true)
        ) ;_ end of while
      ) ;_ end of progn
    (progn
      (setq selset (ssget "_I"))
      (while (not selset)
        (prompt msg)
        (setq selset (ssget))
        ) ;_ end of while
      (cond
        ((= bit 1)                      ; Скрывать выделенные
         (while (and selset (> (sslength selset) 0))
           (setq item (ssname selset 0))
           (ssdel item selset)
           (vla-put-visible (vlax-ename->vla-object item) :vlax-false)
           ) ;_ end of while
         )
        ((= bit 2)                      ; Скрывать кроме выделенных
         (setq selset_all (ssget "_A"))
         (while (and selset_all (> (sslength selset_all) 0))
           (setq item (ssname selset_all 0))
           (ssdel item selset_all)
           (if (not (ssmemb item selset))
             (vla-put-visible (vlax-ename->vla-object item) :vlax-false)
             ) ;_ end of if
           ) ;_ end of while
         )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun

Re: LISP. Аналог Isolate objects (ADT) для AutoCAD

Функция хороша, но есть одно но. Если объект на заблокированном слое то выйдет ошибка с "вылетом", поэтому vla-put-visible надо бы пропустить  через
(vl-catch-all-error-p(vl-catch-all-apply и там же сделать счетчик объектов для которых неудалось поменять свойство чтобы сообщить об этом пользователю.

Re: LISP. Аналог Isolate objects (ADT) для AutoCAD

Нда, что-то про слои я позабыл... Может, тогда просто временно разблокировать слой, сделать свойство visible, а потом разблокировать?

Re: LISP. Аналог Isolate objects (ADT) для AutoCAD

Значится так, как говаривал тов.Жеглов. Код немного переделал. НО! Сносится ассоциативность штриховки. На файлах с большим количеством объектов тормозит безбожно. Слой временно разблокируется и потом возвращается обратно. Вариант с замороженными и отключенными слоями не обрабатывается - возможны проблемы (если честно, то уже было лень вводить дополнительные проверки на возможность установки заморозки слоя). На всякий случай переделанный вариант:

;|=============================================================================
*    Скрытие выбранных объектов / невыбранных объектов / показ всех объектов.
* Сделано в качестве попытки создания аналога ADT-шной команды Isolate objects.
* Работает только в активном пространстве.
*    Параметры вызова:
*  bit  что делать. 0 - показать все; 1 - скрыть выделенные; 2 - скрыть
*    все, кроме выделенных
*    Примеры вызова:
(kpblc-objects-hide 0)  ; Показать все объекты
(kpblc-objects-hide 1)  ; Скрыть выделенные объекты
(kpblc-objects-hide 2)  ; Скрыть все, кроме выделенных
=============================================================================|;
(defun kpblc-objects-hide (bit / selset selset_all msg item _regenmode_)
  ;; Локальные функции
  (defun loc:put_visible(vla-ent vis / layer layer_lock)
    (setq layer (vlax-ename->vla-object (tblobjname "layer" (vla-get-layer item)))
          layer_lock (vla-get-lock layer))
    (vla-put-Lock layer :vlax-false)
    (vla-put-Visible vla-ent vis)
    (vla-put-lock layer layer_lock)
    )
  ;; Конец локальных функций
  (vl-load-com)
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (setq _regenmode_ (getvar "regenmode"))
  (cond
    ((= bit 1) (setq msg "Скрыть выделенные объекты"))
    ((= bit 2) (setq msg "Скрыть кроме выделенных"))
    ) ;_ end of cond
  (if (= bit 0)
    (progn
      (setq selset (ssget "_A"))
      (while (and selset (> (sslength selset) 0))
        (setq item (ssname selset 0))
        (ssdel item selset)
        (setq item (vlax-ename->vla-object item)              )
        (if (vlax-property-available-p item 'visible)
          (loc:put_visible item :vlax-true)
          ) ;_ end of if
        ) ;_ end of while
      ) ;_ end of progn
    (progn
      (setq selset (ssget "_I"))
      (while (not selset)
        (prompt msg)
        (setq selset (ssget))
        ) ;_ end of while
      (cond
        ((= bit 1)                      ; Скрывать выделенные
         (while (and selset (> (sslength selset) 0))
           (setq item (ssname selset 0))
           (ssdel item selset)
           (setq item (vlax-ename->vla-object item))
           (if (vlax-property-available-p item 'visible)
             (loc:put_visible item :vlax-false)
             ) ;_ end of if
           ) ;_ end of while
         )
        ((= bit 2)                      ; Скрывать кроме выделенных
         (setq selset_all (ssget "_A"))
         (while (and selset_all (> (sslength selset_all) 0))
           (setq item (ssname selset_all 0))
           (ssdel item selset_all)
           (if (not (ssmemb item selset))
             (progn
               (setq item (vlax-ename->vla-object item))
               (if (vlax-property-available-p item 'visible)
                 (loc:put_visible item :vlax-false)
                 ) ;_ end of if
               ) ;_ end of progn
             ) ;_ end of if
           ) ;_ end of while
         )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if
  (setvar "regenmode" 1)
  (vla-regen *kpblc-activedoc* acallviewports)
  (setvar "regenmode" _regenmode_)
  (vla-endundomark *kpblc-activedoc*)
  ) ;_ end of defun

Re: LISP. Аналог Isolate objects (ADT) для AutoCAD

Я поступил вот так:

(defun c:unvis(/ errCount wMode objSet actDoc)
  (vl-load-com)
  (defun put_Visible_Prop(Object Flag)
    (if
      (vl-catch-all-error-p
    (vl-catch-all-apply
      'vla-put-visible (list Object Flag)))
          (setq errCount(1+ errCount))
    ); end if
  (princ)
  ); end of put_Visible_Prop
  (defun Set_to_List(SelSet)
    (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex SelSet))))
  ); end of Set_to_List
  (defun errMsg()
    (if(/= 0 errCount)
  (princ(strcat ", " (itoa errCount)
        " were on locked layer."))
      "."
  ); end if
    ); end of errMsg
(setq actDoc(vla-get-ActiveDocument
          (vlax-get-Acad-object))
      errCount 0); end setq
(vla-StartUndoMark actDoc)
(initget "Visible Unvisible" 1)
  (setq wMode
    (getkword "\nMake objects [Visible/Unvisible]: "))            
  (if(and
       (= wMode "Visible")
       (setq objSet(ssget "_X" '((60 . 1))))
       ); end and
    (progn
      (setq objSet(Set_to_List objSet))
   (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-true))objSet)
    (princ
      (strcat "\n<< "
          (itoa(-(length objSet)errCount))
           " now visible" (errMsg) " >>"))
      ); end progn
    (progn
      (if(not(setq objSet(ssget "_I")))
    (setq objSet(ssget))
    ); end if
      (if objSet
    (progn
      (setq objSet(Set_to_List objSet))
  (mapcar
    '(lambda(x)(put_Visible_Prop x :vlax-false))objSet)
    (princ
      (strcat "\n<< "
          (itoa(-(length objSet)errCount))
           " now unvisible" (errMsg) " >>"))
      ; end if
     ); end progn
    ); end if
       ); end progn
      ); end if
  (vla-EndUndoMark actDoc)
(princ)
); end of c:unvis