Тема: Поместить все объекты блока в ЗАДАННЫЙ слой

Добрый день, мастера лиспа. Помогите пожалуйста с такой задачей

Есть блок в нем есть объекты (отрезки, полилинии, окружности и т.д.)

дано:
- Все элементы блока лежат в слое "0" (как вариант любой другой, или даже разные элементы в разных слоях)
- Блок лежит в слое "конструкция"

задача.
- перенести все элементы входящие в блок в слой где находится этот блок или как дополнительный вариант задавать имя слоя руками. (т.е. блок и все его элементы будут лежать в слое "конструкция" и даже после расчленения будут оставаться там же)

Спасибо.

п.с. поиск юзал, все что находил мало подходит, да и для 10 автокада мало что работает(

Re: Поместить все объекты блока в ЗАДАННЫЙ слой

Сергей К,
QUOTE]Сергей К пишет:
да и для 10 автокада мало что работает([/quote]
Я последний раз работал с 10 Автокадом в году эдак 1992-1994. Кроме того (насколько я помню) для него требовалась файловая система FAT16
Если все же имеется ввиду 2010 Автокад, то
1. Блоки нужно делать правильно (т.е. слой 0 )( [URL=http://forum.dwg.ru/showthread.php?t=21492]LISP. Нормализация блоков текущего файла.[/URL] )
2. Для разбивки использовать[URL=http://forum.dwg.ru/showthread.php?t=24279] BURST[/URL] из Express Tools и (или) команду [B]XPLODE[/B]

Re: Поместить все объекты блока в ЗАДАННЫЙ слой

2010 конечно имею ввиду
1. Блоки нужно делать правильно
я считаю что это как раз не правильно в моем понимании
элементы блока хочу именно в том слое в котором находится он сам, потомучто некоторые потом их начинают разбивать и прочее и ищи их потом где попало
norm-blocks bit
пробовал до того как задать пост, у меня почему то не получилось вызвать этот лисп

Re: Поместить все объекты блока в ЗАДАННЫЙ слой

Никто не поможет с проблемой?
в очередной раз начинаю поиск подобного лиспа(

(изменено: _CB_, 30 ноября 2010г. 10:48:08)

Re: Поместить все объекты блока в ЗАДАННЫЙ слой

Подобная задача на этом форуме и на соседнем (dwg.ru) решалась неоднократно (состав блока, список текстовых примитивов в блоке и т.д.). Простейший пример того, что ты хочешь:

(defun test (/ blk a b put-layer-block)
 (vl-load-com)
  (defun put-layer-block (block-name layer)
     (if (tblobjname "block" block-name)
      (vlax-for ent
                    (vla-item
                      (vla-get-blocks
                        (vla-get-activedocument
                          (vlax-get-acad-object)
                        ) ;_ end of vla-get-activedocument
                      ) ;_ end of vla-get-blocks
                      block-name
                    ) ;_ end of vla-item
        (vla-put-Layer ent layer)
        (if (= (strcase (vla-get-objectname ent) t)
               "acdbblockreference"
            ) ;_ end of =
          (put-layer-block (vla-get-name ent) layer)
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of if
  ) ;_ end of defun
  (setq blk (car (entsel "\nВыбери блок ")))
  (if (and blk
           (= (cdr (assoc 0 (entget blk))) "INSERT")
           (setq a (cdr (assoc 2 (entget blk))))
           (setq b (cdr (assoc 8 (entget blk))))
      ) ;_ end of and
    (put-layer-block a b)
  ) ;_ end of if
  (princ)
) ;_ end of defun

Однако задача, которую ты ставишь, просто неверна по своей сути. Представь себе блок, в котором одни примитивы на слое "layer1", у которого Linetype - continuos, другие примитивы на слое "layer2", у которого Linetype - hidden, следующие на ходятся в слое, который заморожен, невидим и т.д. Результат очевиден...

(изменено: Артем Бондаренко, 1 декабря 2010г. 14:07:31)

Re: Поместить все объекты блока в ЗАДАННЫЙ слой

Вот для своих нужд писал похожий вариант. Может пригодиться.

;; Функция задает всем обьектам блока слой
(defun c:gp-block-l( / layers block-name i ss_nabor old_cmdecho)
  (initget 128)
  (setq layers (getvar "CLAYER"))
  (if (not (setq layers (getkword (strcat "\nВведите имя слоя: [\"" (getvar "CLAYER") "\"]> "))))
    (setq layers (getvar "CLAYER"))
  );_if
  (vl-load-com)
  (setq active_document (vla-get-activedocument (vlax-get-acad-object)))
  (setq old_cmdecho (getvar "cmdecho"));;изм №1
  (setvar "cmdecho" 0);;изм №1
  (vla-startundomark active_document);;изм №1
  ; необходимо удостовериться в наличии слоя   
  (setvar "CLAYER" layers)
  (setq ss_nabor (ssget  '((0 . "INSERT"))))
  (if (null ss_nabor)
    (progn
      (princ "\n Блок не выбран!")
      (princ)
    );_progn
    (progn
      (setq i 0)
      (while (< i (sslength ss_nabor))
    (setq block-name  (cdr(assoc 2 (entget(ssname ss_nabor i)))))
    (block-to-layer layers block-name)
    (setq i (+ 1 i))
      );_while
    );_progn
  );_if
  (vla-endundomark active_document)
  (setvar "cmdecho" old_cmdecho)
);_defun


;; функция переводит блок на один слой layer_name с сохранением свойств объектов 
(defun block-to-layer (layer_name block-name / adoc bl prop linetype ss linecolor  subent)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (vlax-for bl (vla-get-blocks adoc)
    ;(vlax-dump-object (vla-get-blocks adoc) t)
    (if    (wcmatch (strcase (vla-get-name bl) t) block-name)
      (vlax-for   subent bl
    (foreach prop (list 
                (list "linetype" "byblock")
                (list "layer" layer_name)                
                )

      ;(vlax-dump-object subent t)
      (if (= (car prop) "linetype")
        (progn
          (if (or (= (setq ss (vlax-get-property   subent (car prop) )) "ByLayer")
              (= (setq ss (vlax-get-property   subent (car prop) )) "ByBlock"))
        (progn
          (setq linetype(cdr (assoc 6  (TBLSEARCH "LAYER" (vlax-get-property   subent "layer" )))))
          (setq prop (list (car prop) linetype ))
          );_progn
        (progn
          (setq ss(vlax-get-property   subent (car prop) ))
          (setq prop (list (car prop) ss ))
          );_progn
        );_if
          );_progn
        )
      (vl-catch-all-apply
        'vlax-put-property
        (list subent (car prop) (cadr prop))
        ) ;_ end of vl-catch-all-apply
      ;(vlax-dump-object subent t)
      ) ;_ end of foreach
    ) ;_ end of vlax-for
      ) ;_ end of if    
    ) ;_ end of vlax-for 
 (vla-endundomark adoc)
 (vla-regen adoc acAllViewports)
 (princ)
) ;_ end of defun

Т.к. в канторе есть только AutoCAD 2007, то проверить на работоспособность не могу под AutoCAD 2010.