; Этот код написал Александр Valrond Ющенко
; Если Вам нужен лисп для решения более специализированных задач - обращайтесь!
; Для связи со мной - val@allforproject.ru

(defun c:OBJTOLAYER ( / valid_name layer_name act_del_layers block_family layers_family acad_application active_document)
	(vl-load-com) 
	(setq acad_application (vlax-get-acad-object)) 
	(setq active_document (vla-get-ActiveDocument acad_application)) 	
	(setq valid_name nil)
	(while (not valid_name)
		(initget 1)
		(setq layer_name (getstring T "Укажите имя слоя. Если такого слоя нет то он будет создан автоматически:"))
		(if (snvalid layer_name 0) 
			(progn ;true
				(setq valid_name T) 
			)
			(progn ;false
				(alert "Вы указали не корректное имя слоя.\nПопробуйте еще раз.")
			)
		)
	)
	(if (null (tblsearch "LAYER" layer_name))
		(progn ;true
			(entmakex
						(list
							(cons 0 "LAYER")
							(cons 100 "AcDbSymbolTableRecord")
							(cons 100 "AcDbLayerTableRecord")
							(cons 2  layer_name)
							(cons 70 0) 
							(cons 62 7)
							(cons 290 1) ;  печатать
						)		
			)
		)
	)
	(initget  "Да Нет")
	(setq act_del_layers (getkword "Удалить оставшиеся пустые слои? [Да/Нет] <Да>:"))
	(if (null act_del_layers) (setq act_del_layers "Да"))
		(setq block_family (vla-get-blocks active_document)) 
		(vlax-for 
			block 
			block_family
			(vlax-for	
				ent 
				(vla-item block_family (vla-get-Name block))
				(vla-put-Layer ent layer_name)
			) 
		)
	(if (= act_del_layers "Да")
		(progn ;true
			(setvar "clayer" "0")
			(setq layers_family (vla-get-Layers active_document)) ; получили семейство слоев
			(vlax-for 
					vla_layer 
					layers_family
					(setq result 
						(vl-catch-all-apply
							'(lambda 
								(layer_to_delete)
								(vla-delete layer_to_delete) 
							) 
							(list vla_layer) 
						)
					)
			)
		)
	)
	(setvar "clayer" layer_name)
	(princ)
)