[Кочетков Андрей]

Прошу помочь в написании программы, которая сохраняет состояние слоев выделенных объектов:

- включен/выключен
- цвет
- толщина линии
- тип линии

с последующим восстановлением этого состояния в другом файле.

[Do$]

Программа на LISP?
В чем сложность?

[Кочетков Андрей]

Язык не важен.
Сложность в том, что мне нужна эта программа )))

[Кулик Алексей aka kpblc]

Layer States Manager?

[nik_mb]

Сообщение от Кочетков Андрей Язык не важен. Сложность в том, что мне нужна эта программа )))

Типа заказчик - По моему хотенью, по моему веленью...

[Do$]

Если стандартные средства не устраивают, можно попробовать поизвращаться...
Как я себе представляю:

1. Запускаем программу №1 в чертеже-источнике. Она просит выделить объекты. Объекты выделяем, жмем энтер, программа сохраняет указанные свойства слоев во внешний текстовый файл.
2. Запускаем программу №2 в чертеже-приемнике. Она считывает данные из текстового файла и создает слои со свойствами, указанными в файле.

Так чтоли?
Как-то сложно получается. Зачем такие извращения-то понадобились?

[Кочетков Андрей]

Сообщение от Кулик Алексей aka kpblc Layer States Manager?

В принципе, да. Но с помощью LSM переносятся состояния всех слоев чертежа, а нужно только выбранных объектов.

Сообщение от Do$ Как я себе представляю: ... Так что ли?

Примерно так я себе это и представлял.
Но решения могут быть любыми.

[Do$]

Сообщение от Кочетков Андрей Прошу помочь в написании программы, которая сохраняет состояние слоев выделенных объектов: - включен/выключен - цвет - толщина линии - тип линии с последующим восстановлением этого состояния в другом файле.

А как выделять объекты на выключенном слое?

[VVA]

Кочетков Андрей, Если все делать в одном сеансе (типа открыл и чертеж-источник и чертеж приемник), то можно обойтись без файла (VL-PROPAGATE ). Так устроит?

[Кочетков Андрей]

Сообщение от Do$ А как выделять объекты на выключенном слое?

Да, не подумал.
Проблема изначально пошла из блоков: при вставке блока из одного файла в другой, его отображение нарушалось за счет иных настроек слоев файла-приемника (в том числе некоторые объекты не отображаются вообще, т.к. слой выключен).
Блоки сложные, многоярусные. Вручную переопределять параметры достаточно сложно.

Сообщение от VVA Если все делать в одном сеансе (типа открыл и чертеж-источник и чертеж приемник), то можно обойтись без файла (VL-PROPAGATE ). Так устроит?

Да, конечно!

В связи с первым предыдущим замечанием я хотел бы изменить условие создание набора:
в набор попадают объекты
- выделенные вручную
- входящие в состав выбранного вручную блока (в том числе в состав подблоков).

[Nike]

По-моему проще перед копированием слои переименовать, или к их именам добавить какой-нибудь индекс, чтоб имена не совпали и настройки сохранились. Или важно имена слоев сохранять?

[Кочетков Андрей]

Сохранение имен слоев предпочтительнее для моего случая.
Иначе можем получить гигантский список с которым в дальнейшем невозможно будет работать.

[Do$]

Сообщение от Кочетков Андрей Прошу помочь в написании программы, которая сохраняет состояние слоев выделенных объектов: - включен/выключен - цвет - толщина линии - тип линии с последующим восстановлением этого состояния в другом файле.

А как быть, если в чертеже-приемнике не загружены необходимые типы линий?
Как их програмно перенести из чертежа-источника?
Программу написал, но споткнулся на этом...

[Кочетков Андрей]

Сообщение от Do$ А как быть, если в чертеже-приемнике не загружены необходимые типы линий?

Типы линий у нас используются дефолтные, самодельных практически нет.
Возможно для загрузки пригодится метод Load
Файлы для загрузки acad.lin и acadiso.lin
Если метод не отработал, то присваиваем обрабатываемому слою тип Continious

[Do$]

Ну тогда не буду ломать голову пока...
Пробуйте.

Код:

[Выделить все]

(defun C:olscopy (/
    select
    *error*
    objlayimp
    objlayexp
    repeat-member-remove-from-list
    block-item-list
    _dwgru-is-ent-block-reference
    _dwgru-property-get
    _dwgru-conv-ent-to-vla
    _dwgru-conv-pickset-to-list
   )
;;;Основные функции программы:
;;;*************************************************************************************************
  (defun objlayimp (/ adoc layers lay)
;;;(objlayimp)
    (if *olsc:object_layer_state_list*
      (progn
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
       layers (vla-get-Layers adoc)
       linetypes (vla-get-Linetypes adoc)
 ) ;_ end of setq
 (prompt "\nИмпортированы слои и/или настройки слоев:")
 (foreach
    lay_state
      *olsc:object_layer_state_list*
   (setq lay (vla-add layers (car lay_state)))
   (prompt "\n\t\t")
   (prin1 (car lay_state))
   (if
     (or
       (tblsearch
  "ltype"
  (setq linetype (cdr (assoc "Linetype" (cdr lay_state))))
       ) ;_ end of tblsearch
       (not (vl-catch-all-error-p
       (vl-catch-all-apply
         'vla-load
         (list linetypes linetype "acad.lin")
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of vl-catch-all-error-p
       ) ;_ end of not
       (not (vl-catch-all-error-p
       (vl-catch-all-apply
         'vla-load
         (list linetypes linetype "acadiso.lin")
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of vl-catch-all-error-p
       ) ;_ end of not
     ) ;_ end of or
      (setq lay_state (cdr lay_state))
      (setq lay_state (subst (cons "Linetype" "Continuous")
        (cons "Linetype" linetype)
        (cdr lay_state)
        ) ;_ end of subst
      ) ;_ end of setq
   ) ;_ end of if
   (foreach
      prop
   lay_state
     (if (vlax-property-available-p lay (car prop))
       (vlax-put-property lay (car prop) (cdr prop))
     ) ;_ end of if
   ) ;_ end of foreach
 ) ;_ end of foreach
 (setq word
        (vl-catch-all-apply
   (function
     (lambda ()
       (initget "Да Нет _Yes No")
       (getkword
         "\nУдалить импортированные данные о состоянии слоев из памяти? [Да/ Нет]<Да>"
       ) ;_ end of getkword
     ) ;_ end of lambda
   ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
 ) ;_ end of setq
 (if (or (not word) (= word "Yes"))
   (progn (setq *olsc:object_layer_state_list* nil)
   (vl-propagate '*olsc:object_layer_state_list*)
   ) ;_ end of progn
 ) ;_ end of if
      ) ;_ end of progn
      (alert
 "Прежде чем импортировать состояния слоев, их нужно экспортировать!"
      ) ;_ end of prompt
    ) ;_ end of if
  ) ;_ end of defun
 
  (defun objlayexp (/ adoc layers selset obj_list layer_list)
;;;(objlayexp)
    (setq adoc  (vla-get-ActiveDocument (vlax-get-acad-object))
   layers (vla-get-Layers adoc)
    ) ;_ end of setq
    (while (not selset)
      (setq selset
      (vl-catch-all-apply
        (function
   (lambda ()
     (prompt
       "\nУкажите объекты для определения экспортируемых слоев:"
     ) ;_ end of prompt
     (ssget)
   ) ;_ end of lambda
        ) ;_ end of function
      ) ;_ end of vl-catch-all-apply
      ) ;_ end of setq
      (cond
 ((not selset) (prompt "\nНе указаны объекты!"))
 ((vl-catch-all-error-p selset)
  (prompt "\nПрервано пользователем!")
 )
 (T (setq obj_list (_dwgru-conv-pickset-to-list selset)))
      ) ;_ end of cond
    ) ;_ end of while
    (if obj_list
      (progn
 (foreach
    ent
       obj_list
   (setq layer_list
   (cons (_dwgru-property-get ent (quote Layer)) layer_list)
   ) ;_ end of setq
   (if (_dwgru-is-ent-block-reference ent)
     (setq layer_list
     (append
       (mapcar
         (function
    (lambda (a) (_dwgru-property-get a (quote Layer)))
         ) ;_ end of function
         (block-item-list ent)
       ) ;_ end of mapcar
       layer_list
     ) ;_ end of append
     ) ;_ end of setq
   ) ;_ end of if
 ) ;_ end of foreach
 (setq *olsc:object_layer_state_list*
        (mapcar
   (function
     (lambda (b)
       (cons
         b
         (mapcar
    (function
      (lambda (a)
        (cons a
       (vlax-get-property (vla-Item layers b) a)
        ) ;_ end of cons
      ) ;_ end of lambda
    ) ;_ end of function
    (list "Linetype"
          "TrueColor"
          "Lineweight"
          "LayerOn"
    ) ;_ end of list
         ) ;_ end of mapcar
       ) ;_ end of cons
     ) ;_ end of lambda
   ) ;_ end of function
   (repeat-member-remove-from-list
     layer_list
   ) ;_ end of repeat-member-remove-from-list
        ) ;_ end of mapcar
 ) ;_ end of setq
 (vl-propagate (quote *olsc:object_layer_state_list*))
 (prompt
   (strcat
     "\nЦвет, вес линии, тип линии, и состояние включен/выключен"
     "\nследующих слоев сохранены в памяти:"
   ) ;_ end of strcat
 ) ;_ end of prompt
 (foreach
    lay_name
    (mapcar (function car) *olsc:object_layer_state_list*)
   (prompt "\n\t\t")
   (prin1 lay_name)
 ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
;;;Вспомогательные функции собственной разработки:
;;;*************************************************************************************************
 
  (defun *error* (msg)
    (alert
      (strcat
 "В процессе работы программы возникла ошибка! Сообщите о ней разработчику!"
 "\n***\n"
 msg
 "\n***"
      ) ;_ end of strcat
    ) ;_ end of alert
  ) ;_ end of defun
 
  (defun repeat-member-remove-from-list (lst / memb rez)
     ;|
Функция для удаления повторяющихся элементов списка.
 lst - список
Возможен некорректный результат для списка из вещественных чисел.
Пример вызова:
(repeat-member-remove-from-list '("a" "b" "c" "b" "c" "c" "aa" "a" "bb"))
->("a" "b" "c" "aa" "bb")
|;
    (while lst
      (setq memb (car lst)
     lst  (vl-remove-if
     (function
       (lambda (m) (equal memb m))
     ) ;_ end of function
     (cdr lst)
   ) ;_ end of vl-remove-if
     rez  (cons memb rez)
      ) ;_ end of setq
    ) ;_ end of while
    (reverse rez)
  ) ;_ end of defun
 
  (defun block-item-list
  (blk / blocks lst memb rez block-item-list-recurse)
  ;|
Функция получения списка VLA-указателей на объекты в составе блока,
включая объекты в составе вложенных блоков. Список не содержит повторяющихся
объектов.
(setq test (block-item-list (car (entsel))))
|;
    (defun block-item-list-recurse (blk / item_list)
       ;|
Функция получения списка VLA-указателей объекты в составе блока,
включая объекты в составе вложенных блоков. Список может содержать
повторяющиеся объекты, если они входят в состав блока несколько раз.
(block-item-list-recurse (car (entsel "\nУкажите блок:")))
|;
      (if (_dwgru-is-ent-block-reference blk)
 (vlax-for item
         (vla-item
    blocks
    (_dwgru-property-get blk 'EffectiveName)
         ) ;_ end of vla-item
   (setq item_list (cons item item_list))
   (if (_dwgru-is-ent-block-reference item)
     (setq item_list
     (append (block-item-list-recurse item) item_list)
     ) ;_ end of setq
   ) ;_ end of if
 ) ;_ end of vlax-for
      ) ;_ end of if
      item_list
    ) ;_ end of defun
    (setq blocks (vla-get-Blocks
     (vla-get-ActiveDocument (vlax-get-acad-object))
   ) ;_ end of vla-get-Blocks
    ) ;_ end of setq
;;;  (while lst
;;;    (setq memb (car lst)
;;;   lst  (vl-remove-if
;;;   (function
;;;     (lambda (m) (equal memb m))
;;;   ) ;_ end of function
;;;   (cdr lst)
;;;        ) ;_ end of vl-remove-if
;;;   rez  (cons memb rez)
;;;    ) ;_ end of setq
;;;  ) ;_ end of while
    (repeat-member-remove-from-list
      (block-item-list-recurse blk)
    ) ;_ end of repeat-member-remove-from-list
  ) ;_ end of defun
 
;;;Вспомогательные функции из библиотеки DWG.RU
;;;*************************************************************************************************
  (defun _dwgru-is-ent-block-reference (ent)
           ;|
 *    Проверяет, является ли переданный примитив указателем на вхождение
 * блока (BlockReference).
 *    Параметры вызова:
  ent проверяемый примитив. Допустимые значения:
    ename
    vla-object
    string ; обрабатывается как хендл примитива
 *    Возвращает t (объект - вхождение блока) или nil (любой иной объект)
 *    Примеры вызова:
 (_dwgru-is-ent-block-reference (car (entsel "\nУкажите любой объект : ")))
 |;
    (and (= (_dwgru-property-get ent 'objectname)
     "AcDbBlockReference"
  ) ;_ end of =
  (not (_dwgru-property-get ent 'path))
    ) ;_ end of and
  ) ;_ end of defun
  (defun _dwgru-property-get (obj prop)
        ;|
 *    Получение значения свойства объекта.
 *    Параметры вызова:
  obj указатель на объект. Допускается применение ename, vla, строки
   (в последнем случае воспринимается как хендл объекта)
  prop имя свойства. Может быть строкой или атомом
 *    Возвращает значение указанного свойства. Если свойства у объекта нет,
 * возвращает nil.
 *    Примеры вызова:
 (_dwgru-property-get (vla-get-ActiveDocument (vlax-get-acad-object)) 'activelayer)
  ; #<VLA-OBJECT IAcadLayer2 064b04e4>
 (_DWGRU-PROPERTY-GET (vla-get-ActiveDocument (vlax-get-acad-object)) 'layer)
  ; nil
 |;
    (if (and (setq obj (_dwgru-conv-ent-to-vla obj))
      (vlax-property-available-p obj prop)
 ) ;_ end of and
      (vlax-get-property obj prop)
    ) ;_ end of if
  ) ;_ end of defun
 
  (defun _dwgru-conv-ent-to-vla (ent)
    ;|
 *    Выполняет преобразование переданного указателя в vlax-вариант
 *    Параметры вызова:
  ent обрабатываемый указатель. Может быть:
    ename
    vla-object
    строка (воспринимается как хендл примитива).
 *    Примеры вызова:
 (setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
 (_dwgru-conv-ent-to-vla entity) ; #<VLA-OBJECT IAcadPoint 064ad294>
 |;
    (cond
      ((= (type ent) 'vla-object) ent)
      ((= (type ent) 'ename) (vlax-ename->vla-object ent))
      ;|
 ;; Оригинальный вариант:
 ((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
 |;
      ;; Исправления Alaspher от 28.11.2007. Начало.
      ((= (type ent) 'str)
       (if (setq ent (handent ent))
  (vlax-ename->vla-object ent)
       ) ;_ end of if
      )
      ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
 
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
    item (sslength value)
     ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun
;;;*************************************************************************************************
  (vl-load-com)
  (setq select
  (vl-catch-all-apply
    (function
      (lambda ()
        (initget "Экспорт Импорт Выход _Export Import Quit")
        (getkword
   "\nКакое действие нужно выполнить?:[Экспорт/ Импорт/ Выход]<Экспорт>"
        ) ;_ end of getkword
      ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
  (cond
    ((or (vl-catch-all-error-p select) (= select "Quit"))
     (prompt "\nПрервано пользователем!")
    )
    ((or (not select) (= select "Export")) (objlayexp))
    ((= select "Import") (objlayimp))
    (T (prompt "\nЧто-то не так..."))
  ) ;_ end of cond
  (princ)
) ;_ end of defun

[Кулик Алексей aka kpblc]

Ну, и мой вариант Вроде все лишнее снес.

[Кочетков Андрей]

Спасибо большое!
Сейчас доберусь до компа - потестю, отпишусь )

[Do$]

Моя лучше!
Шутка...
В этих вариантах есть существенные разницы:

1) Передача данных между чертежами:

• Вариант от Алексея: сохранение данных в файл из одного чертежа, затем восстановление данных из файла в другом чертеже. Поэтому неважно когда будет открыт файл-приемник (в этом сеансе, в следующем, на другой день, через год...), данные о состоянии слоев не теряются (если ini файл не удалять ).
• В моем варианте передача данных между чертежами возможна только если они были открыты в одном сеансе. После завершения сеанса данные теряются. Зато телодвижений меньше!

2) Поведение программы, если в чертеже-приемнике нет слоя, настройки которого экспортированы из другого чертежа:

• В варианте Алексея настройки этого слоя не импортируются
• В моем слой создается с сохраненными настройками

3) Передаваемые свойства слоев

• У Алексея - все
• У меня - только заказанные (Кстати, добавить совсем не сложно...)

4) Проверка объектов блока

• У Алексея - только первый уровень вложенности, зато обрабатываются внешние ссылки (ExtrnalReference). Я вот только не понял насчет размеров - их тоже надо рассматривать как блоки?
• У меня - все уровни вложенности, но внешние ссылки и размеры как блоки не обрабатываются.

[Кулик Алексей aka kpblc]

Ну, скажем, у меня не все настройки передаются (в частности, некорректно будет обработан слой с TrueColor).
Насчет вложенности блоков - да, я просто не стал это делать (если надо, то можно и добавить). Специально сделал так, чтобы дин.блоки обрабатывались "не полностью".
И по поводу размеров: теоретически (при нормальной организации файла и настройках размерных стилей) такое, конечно, не требуется. Но лично я встречал файлы, где размеры (именно размеры, а не стили!) были расцвечены как новогодняя елка. Приходилось и такое чистить.

[Do$]

Сообщение от Кулик Алексей aka kpblc Но лично я встречал файлы, где размеры (именно размеры, а не стили!) были расцвечены как новогодняя елка.

Да и пусть себе! Или на свойства слоев это как-то влияет? Я понимаю, что эту программу ты "вырезал" из более сложной какой-то, может быть поэтому в ней и остались размеры. Или же в составе размеров могут быть какие-то объекты, которые могут быть в разных слоях?