[{Smirnoff}]

Перекинуть объекты из примерно 200 слоёв в один, но с сохранением внешнего вида примитивов (в смысле и цвета и веса линий как они были по соответствующему слою). Самому времени писать сейчас нет да и на поиск тоже.

[Лентяй]

В первом приближении для цвета и типа линии:

Код:

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

(defun L2L (nlay / lys)
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        lys (vla-get-layers adoc))
  (prompt "\nSelect Objects to Transfer")
  (ssget)
  (setq ass (vla-get-ActiveSelectionSet adoc))
  (vlax-for obj ass
    (vlax-for lay lys
      (if (= (vla-get-name lay) (vla-get-layer obj))
        (progn
          (vla-put-color obj (vla-get-ColorIndex (vla-get-TrueColor lay)))
          (vla-put-linetype obj (vla-get-linetype lay))
          (vla-put-layer obj nlay))))
  );vlax-for
);end

[{Smirnoff}]

>Лентяй
Спасибо что откликнулся. Правда требовалось еще чтобы объекты которые имели свойства не ByLayer их сохраняли а не брали их из свойств слоя. В общем задача чтобы выглядело как было, но на одном слое. Накатал тут по быстрому свой вариант, немного непродуманно но работает:

Код:

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

(defun c:olay(/ actSet actDoc actLay curLay layCol errCount)
  (vl-load-com)
  (if
    (not
      (setq actSet(ssget "_I")))
      (setq actSet(ssget))
    ); end if
  (if actSet
    (progn
    (setq actSet
	   (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex actSet))))
	  actDoc(vla-get-ActiveDocument
		    (vlax-get-acad-object))
	  layCol(vla-get-Layers actDoc)
	  actLay(vla-get-ActiveLayer actDoc)
	  errCount 0
	  ); end setq
    (vla-StartUndoMark actDoc)
    (foreach ent actSet
       (setq curLay
	   (vla-item layCol(vla-get-Layer ent)))
      (if
	(equal "ByLayer"(vla-get-Linetype ent))
	(if
	  (not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply
	 'vla-put-Linetype (list ent(vla-get-Linetype curLay)))))
	  t); end if
	); end if
      (if
	(equal acLnWtByLayer(vla-get-Lineweight ent))
	(if
	  (not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply
	 'vla-put-Lineweight(list ent(vla-get-Lineweight curLay)))))
	  t); end if
	); end if
      (if
	(equal 256(vla-get-Color ent))
	(if
	  (not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply
	'vla-put-Color (list ent(vla-get-Color curLay)))))
	      t); end if
	); end if
      (if
	(vl-catch-all-error-p
	  (vl-catch-all-apply 'vla-put-Layer
	                         (list ent(vla-get-Name actLay))))
	(setq errCount(1+ errCount))
    ); end if
   ); end foreach
    (if(/= 0 errCount)
      (princ(strcat "\n"(itoa errCount)" were on locked layer!"))
      ); end if
     ); end progn
    (vla-EndUndoMark actDoc)
    ); end if
    (princ)
    ); end of c:olay

Надо бы дописать обработку примитивов в блоках, потому что если у них к примеру толщина линии ByLayer то при переносе в другй слой они будут выглядеть иначе. Ну да ладно, для решения моей задачи меня и это удовлетворяет.

[Лентяй]

Все выгладит нормально, за исключением (vla-put-color). Не помню, как в пердыдущих версиях, но в 2005 вытаскивание цвета из описания слоя впрямую невозможно за отсутствием свойсва Color. Вместо него существует объект TrueColor, имеющий свойство ColorIndex, соотв-е номеру цвета в Color Palette. Потому вместо (vla-get-Color curLay) сдудует использовать (vla-get-ColorIndex (vla-get-TrueColor curLay)). А в остальном, прекрасная маркиза...

Надо бы дописать обработку примитивов в блоках, потому что если у них к примеру толщина линии ByLayer то при переносе в другй слой они будут выглядеть иначе.

(setq bks (vla-get-Blocks actDoc))
(vlax-for blk bks..., и далее, как уже сказано выше.

[{Smirnoff}]

но в 2005 вытаскивание цвета из описания слоя впрямую невозможно за отсутствием свойсва Color

Я до сих пор работаю в 2004-м, потому что на работе всё строго лицензионное. А дома особой потребности в следующих версиях нет, потому что как ты понимаешшь у "людей лиспа" есть куча всяких комбинаций на клаве и если не лениво кнопочек которые с лихвой окупают последующие версии. Но изучать их конечно надо, ломаю шефа на апгрейд до 2006-го. Спасибо за ценные замечания.

А в остальном, прекрасная маркиза...

В данном варианте полное "Г" и именно потому что необрабатыват блоки, я кстати это дописал, но оставил на работе. Сейчас запарка, поэтому решил задачу и ладно, не сликом полезный для широкой публики липик. Да притом и опасный, запустил из интереса-непонял что произошло-сохранился-закрылся-при следующем откытии начал рвать волосы на одном месте :shock:

[Лентяй]

Я тоже не помню каких-либо проблем с (vla-get-color *LAYER*) в 2000-2002. Более того, не понимаю этого извращения с TrueColor ваще.

...начал рвать волосы на одном месте

А какой программой ты для этого пользовался? Или обошелся аппарвтными средствами? Paldies.