Изменение цыета слоя в нескольких файлах

elena_din · 08.02.2006, 14:58

Подскажите, пожалуйста, возможно ли работать с содержимым файла .dwg не открывая его?
Нужно поменять цвет слоя в боьшом количестве файлов.
Как это можно сделать быстрее, чем меняя в каждом файле?

Спасибо большое!

Alan · 08.02.2006, 16:10

Цитата:

Подскажите, пожалуйста, возможно ли работать с содержимым файла .dwg не открывая его?

elena_din, Вы имеете ввиду, открывая не Вами?
Способы работы с многими файлами и деланьи в них чего-то обсуждали неоднократно.
Например тут: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=23955Vm
В Вашем случае команда для изменения выглядит примерно так:

Код:

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

(command "_.Layer" "_C"   <номер цвета>  <слой>  "")

Кулик Алексей aka kpblc · 08.02.2006, 16:16

Только имхо это не есть гуд - вставлять как блок (а тут потребуется внешняя ссылка), потом ковырять файл. В данном случае было бы, наверное, проще работать напрямую на файл, открывая его в фоновом режиме и применяя вариант (vla-put-color), ессно, отслеживая возможные ошибки (например, слой отсутствует в файле).

Alan · 08.02.2006, 16:27

Цитата:

Сообщение от kpblc

Только имхо это не есть гуд - вставлять как блок (а тут потребуется внешняя ссылка), потом ковырять файл. В данном случае было бы, наверное, проще работать напрямую на файл, открывая его в фоновом режиме и применяя вариант (vla-put-color), ессно, отслеживая возможные ошибки (например, слой отсутствует в файле).

Да, kpblc, согласен в приведенной мной ссылке способ - "это не есть гуд", не рассмотрел. Но это так много раз рассматривалось. Не хотел я elena_din к тебе сразу посылать.
Конечно здесь ясно - сделать список файлов и передать в подпрограмму, которая всё сделает сама.

VVA · 08.02.2006, 16:39

Переделанный файл с cadalista

Код:

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

;;;CADALYST 03/05 Tip2023: PurgeFiles.lsp	Directory Clean Up	(c) Andrzej Gumula


;;; [c]2004 Andrzej Gumula, Katowice, Poland
;;; e-mail: [email protected]
;;; This routine purge dwg files from selected folder


(vl-load-com)
(defun e->str_razd (str razd / sp b ch i)
  (setq	i 1
	b ""
  )
  (repeat (strlen str)
    (setq ch (substr str i 1))
    (if	(vl-string-search ch razd)
      (setq sp (append sp (list b))
	    b  '""
      )
      (setq b (strcat b ch))
    ) ;_ End of if
    (setq i (+ 1 i))
  ) ;_ End of repeat
  (setq sp (append sp (list b)))
  sp
) ;_ End of defun

(defun layren (/ fil str layer name new_name FN)
  (VL-LOAD-COM)
  (if (null *LAYDAT*)
    (progn
      (setq FN (getfiled "Выберите файл соответствий layren.txt"
			 DwgPath
			 "txt"
			 16
	       )
      )
      (setq fil (open FN "r"))
      (if fil
	(progn
	  (while (setq str (read-line fil))
	    (setq str (VL-STRING-TRIM " " STR))
	    (cond
	      ((= (substr str 1 1) ";") nil)
	      ((= str "") nil)
	      (t
	       (setq str (e->str_razd str "="))
	       (if (and
		     (= (length str) 2)
		     (/= (cadr str) "") ;_Исключаем строки типа LAY_old=
		   )
		 (progn
		   (setq str
			  (list	(strcase (VL-STRING-TRIM " " (car str)))
				(VL-STRING-TRIM " " (cadr str))
			  )
		   )
		   (setq *LAYDAT* (append *LAYDAT* (list str)))
		 )
	       )
	      )
	      (t nil)
	    )
	  )
	  (close fil)
	)
      )
      (VL-PROPAGATE '*LAYDAT*)
    )
  )
  (if *LAYDAT*
    (progn
;;;      (vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vlax-for	layer (vla-get-Layers File)
	(setq name (strcase (vla-get-name layer)))
	(if (not (member name '("0" "DEFPOINTS"))) ;_Исключаем системные слои
	  (progn
	    (setq new_name (cadr (assoc name *LAYDAT*)))
	    (if	new_name
	      (vla-put-Color layer (atoi new_name))
	    )
	  )
	)
      )
    )
  )
)

(defun c:CLay (/ FilesList SubDir Files)

  (defun GetFolder (/ Dir Item Path)
    (cond
      ((setq Dir (vlax-invoke
		   (vlax-get-or-create-object "Shell.Application")
		   'browseforfolder
		   0
		   "Select folder with DWG files:"
		   1
		   ""
		 )
       )
       (cond
	 ((not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply 'vlax-invoke-method (list Dir 'Items))
	    )
	  )
	  (setq	Item (vlax-invoke-method
		       (vlax-invoke-method Dir 'Items)
		       'Item
		     )
	  )
	  (setq Path (vla-get-path Item))
	  (if
	    (not (member (substr Path (strlen Path) 1) (list "/" "\\")))
	     (setq Path (strcat Path "\\"))
	  )				;end if
	 )
       )				;end cond
      )
    )					;end cond
    Path
  )					;end GetFolder


  (defun vl-findfile (Location / DirList Path AllPath)
    (MakeDirList Location)
    (setq DirList (cons Location DirList))
    (foreach Elem DirList
      (if (setq Path (vl-directory-files Elem "*.dwg"))
	(foreach Item Path
	  (setq AllPath (cons (strcat Elem "/" Item) AllPath))
	)
      )					;end if
    )
    (reverse AllPath)
  )					;end vl-findfile

  (defun MakeDirList (Arg / TmpList)
    (setq TmpList (cddr (vl-directory-files Arg nil -1)))
    (cond
      (TmpList
       (setq
	 DirList (append
		   DirList
		   (mapcar '(lambda (z) (strcat Arg "/" z)) TmpList)
		 )
       )
       (foreach Item TmpList (MakeDirList (strcat Arg "/" Item)))
      )
    )					;end cond
  )					;end MakeDirList






  (if (not FileSystemObject)
    (setq FileSystemObject
	   (vla-getInterfaceObject
	     (vlax-get-acad-object)
	     "Scripting.FileSystemObject"
	   )
    )
  )					;end if

  (cond
    ((= (getvar "SDI") 0)
     (cond
       ((setq DwgPath (GetFolder))
	(initget 1 "Yes No")
	(setq
	  Subdir (cond
		   ((getkword "\nLooking for subfolders? [Yes/No]: "))
		   (T "Yes")
		 )
	)
	(if (equal SubDir "Yes")
	  (setq	Files
		 (vl-findfile (substr DwgPath 1 (1- (strlen DwgPath))))
	  )
	  (setq	Files (mapcar '(lambda (x) (strcat dwgpath x))
			      (vl-directory-files DwgPath "*.dwg" 1)
		      )
	  )
	)				;end if
	(setq Files (mapcar 'strcase Files))
	(cond
	  (Files
	   (vlax-for & (vla-get-documents (vlax-get-acad-object))
	     (setq FilesList
		    (cons (strcase (vla-get-fullname &)) FilesList)
	     )
	   )
	   (foreach & Files
	     (cond
	       ((not (member & FilesList))
		(cond
		  ((/= (logand (vlax-get-property
				 (vlax-invoke-method
				   FileSystemObject
				   'getfile
				   &
				 )
				 'Attributes
			       )
			       1
		       )
		       1
		   )
		   (cond
		     ((setq File (vla-open (vla-get-documents
					     (vlax-get-acad-object)
					   )
					   &
				 )
		      )
		      (prompt
			(strcat "\nЗамена цвета" & ". Подождите...")
		      )
;;;             (vla-purgeall File)
		      (layren)
		      (prompt (strcat "\nSave and close " &))
		      (vla-save File)
		      (vla-close File)
		      (vlax-release-object File)
		     )
		     (T
		      (prompt
			(strcat
			  "\nCannot open "
			  &
			  "\nDrawing file was created by an incompatible version. "
			)
		      )
		     )
		   )			;end cond
		  )
		  (T
		   (prompt (strcat & " is read-only. Purge canceled. "))
		  )
		)			;end cond
	       )
	       (T (prompt (strcat & " is open now. Purge canceled. ")))
	     )				;end cond

	   )				;end foreach
	  )
	  (T (prompt "\nNothing files found to purge. "))
	)				;end cond
       )
       (T (prompt "\nNothing selected. "))
     )					;end cond
    )
    (T (prompt "\nThe routine is not available in SDI mode. "))
  )					;end cond
  (princ)
)					;end c:PurgeFile

(prompt "\n===   Команда загружена. Наберите Clay  ===")
(princ)

Файл соответствий. Сохранить как layren.txt

Цитата:

;;;Строки начинающиеся с ;-комментарии
;;;Структура Имя_существующего_слоя=Цвет_слоя
Слой1=1
Слой2=2
Layer1=1
Layer2=2

Что-то у меня архив ни rar ни zip не хочет прикрепляться

PS >Admin Проверил dwg нормально rar, zip

Цитата:

Загружаемый файл должен быть формата *.gif, *.jpg, *.jpeg, *.dwg, *.dwf, *.rar или *.zip

Вернуться назад

Может чего в IE не так?

elena_din · 09.02.2006, 10:07

А как этим пользоваться?
Загрузить в Autocad не открывая конкретные файлы?
Потом через меню типа как в проводнике?

VVA · 09.02.2006, 10:35

Вот архив.
Там файлы clay.LSP и layren.txt
В layren.txt описываешь соответствия. Например Слой1=1 - в чертежах слой с именем Слой1 сделать красным и т.д.
В Автокаде загружаешь clay.lsp (команда _appload) и в командной строке набираешь CLAY. Указываешь папочку в dwg файлами. Отвечаешь, нужно ли обрабатывать поддиректории, указываешь где файл соответствий layren.txt и все.

[ATTACH]1139470548.rar[/ATTACH]

fixo · 09.02.2006, 10:42

Цитата:

Сообщение от elena_din

А как этим пользоваться?
Загрузить в Autocad не открывая конкретные файлы?
Потом через меню типа как в проводнике?

Код скопировать в блокнот и сохранить в нужном месте
выбрав опцию внизу "Все файлы"
как файл с расширением .lsp (например ChangeLayerColor.lsp)
Открыть любой файл .dwg
Загрузить файл через меню Tools->Load, выделить этот файл и нажать
Load
В командной строке ввести имя комады : C2L (в любом регистре)
Смотреть подсказки в командной строке
Для обработки всех файлов нужно будет указать любой рисунок
из обрабатываемой папки

Код:

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

;; начало кода
;;  Изменение цвета слоя в рисунках выбранной папки
;;  (вложенные папки не обрабатываюся)
;;  A2k+

;;  written by Fatty T.O.H (c) 2005 ;;
;; 	all rights removed	   ;;

;; возвращает объект ObjectDBX ;;
(defun odbx-test (/ dbx_doc)

(if (< (atof (getvar "ACADVER")) 15.06)
(progn (alert "ObjectDBX method not applicable\nin this AutoCAD version")
  (exit)(princ)(gc))
(progn
(if (= (atoi (getvar "ACADVER")) 15)
(progn
(if (not (vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
(startapp "regsvr32.exe"
(strcat "/s \"" (findfile "axdb15.dll") "\"")))

(setq dbx_doc (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument")))

(setq dbx_doc (vla-getinterfaceobject
            (vlax-get-acad-object)
            "ObjectDBX.AxDbDocument.16"))))))


;;==================  ОСНОВНАЯ ЧАСТЬ  =================;;

(defun C:C2L (/		acapp	  adoc	    col_num   dbx_obj
	      fld	fn	fname	  fold	    full_name_list
	      lay_coll	lname	  lyr
	     )
  (vl-load-com)
  (setq	acapp (vlax-get-acad-object)
	adoc  (vla-get-activedocument acapp)
  )

(setq fld (getvar "filedia"))
(setvar "filedia" 0)
(setvar "SDI" 0)  
  (setq
    lname (getstring T "\nВведите имя слоя (с учетом регистра) : \n")
  )
  (setq col_num (getint "\nВведите номер цвета (например 21) : \n"))

  (setq	fn	       (getfiled "Выбрать любой DWG файл в нужной папке"
				 ""
				 "dwg"
				 8
		       )
	fold	       (vl-filename-directory fn)
	full_name_list (vl-directory-files fold "*.dwg" 1)
	full_name_list (mapcar (function (lambda (x)
					   (strcat fold "\\" x)
					 )
			       )
			       full_name_list
		       )
  )
  (foreach other full_name_list
    (setq fname (findfile other))
    (setq dbx_obj (odbx-test))
    (vla-open dbx_obj fname :vlax-false)
    (vlax-for a	(setq lay_coll (vla-get-layers dbx_obj))
      (if (not (vl-catch-all-error-p
		 (setq lyr
			(vl-catch-all-apply
			  (function (lambda ()
				      (vla-item lay_coll lname)
				    )
			  )
			)
		 )
	       )
	  )
	(vla-put-color lyr col_num)
      )
    )
    (vla-saveas dbx_obj (vla-get-name dbx_obj))
  )
  (vlax-release-object dbx_obj)
  (setq dbx_obj nil)
  (gc)
  (gc)
  (setvar "filedia" fld)
  (princ)
)
(prompt "\nВ командной строке ввести C2L \n")
(princ)
;; окончание кода

Fatty

~'J'~

elena_din · 09.02.2006, 11:47

СПАСИБО!!!!!!!!

Vook · 14.02.2006, 17:09

Скрипты

Tony_Chu · 20.11.2008, 10:18

Цитата:

Сообщение от VVA

Вот архив.
Там файлы clay.LSP и layren.txt
В layren.txt описываешь соответствия. Например Слой1=1 - в чертежах слой с именем Слой1 сделать красным и т.д.
В Автокаде загружаешь clay.lsp (команда _appload) и в командной строке набираешь CLAY. Указываешь папочку в dwg файлами. Отвечаешь, нужно ли обрабатывать поддиректории, указываешь где файл соответствий layren.txt и все.

[ATTACH]1139470548.rar[/ATTACH]

Подскажите, а можно ли сделать так чтобы таких файлов (layren.txt) было несколько и они имели разные названия?

Funny_engineer · 07.05.2010, 12:41

Добрый день. Может кто сможет помочь отредактировать кодинг по посту 7, так чтобы он оптом изменял не цвет, а названия слоев в соответствии с файлом layren.txt, а то никак не получается.

АлексЮстасу · 22.09.2010, 14:56

Присоединяюсь к предыдущему оратору. Замена цвета - это то, что нужно.
Но заказчики очень любят поменять в последнюю секунду еще что-нибудь. Реально - прямо сейчас заказчик возжелал поменять и цвета нескольких слоев, и толщину линий в одном из них. Из-за этого пожелания с толщиной все удовольствие от этой программки теряется.
Можно сделать программку для замены большего числа параметров: и толщин, и типов линий и названий?

Но эта программка сама по себе - просто мана небесная))

vadim_evg1 · 22.09.2010, 17:24

Цитата:

Сообщение от АлексЮстасу

Можно сделать программку для замены большего числа параметров: и толщин, и типов линий и названий?

В Help-Paper есть такое, только работает в открытом файле

АлексЮстасу · 22.09.2010, 18:00

Цитата:

Сообщение от vadim_evg1

В Help-Paper есть такое, только работает в открытом файле

Здесь тема пакетной замены во многих файлах.
Т.е. это самое "Help-Paper" сразу сделает нужное во всех файлах указанной папки или т.п.?
И откуда это выуживается?

gizmo_zx · 01.12.2017, 11:42

Бодрого дня.

Пособите поправить LISP.
Заменить цвет всех слоев на цвет "252" (серый)
Для всех файлов папок.

Код:

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

 


;; начало кода
;;  Изменение цвета слоя в рисунках выбранной папки
;;  (вложенные папки не обрабатываюся)
;;  A2k+

;;  written by Fatty T.O.H (c) 2005 ;;
;; 	all rights removed	   ;;

;; возвращает объект ObjectDBX ;;
(defun odbx-test (/ dbx_doc)

(if (< (atof (getvar "ACADVER")) 15.06)
(progn (alert "ObjectDBX method not applicable\nin this AutoCAD version")
  (exit)(princ)(gc))
(progn
(if (= (atoi (getvar "ACADVER")) 15)
(progn
(if (not (vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
(startapp "regsvr32.exe"
(strcat "/s \"" (findfile "axdb15.dll") "\"")))

(setq dbx_doc (vla-getinterfaceobject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument")))

(setq dbx_doc (vla-getinterfaceobject
            (vlax-get-acad-object)
            "ObjectDBX.AxDbDocument.16"))))))


;;==================  ОСНОВНАЯ ЧАСТЬ  =================;;

(defun C:C2L (/		acapp	  adoc	    col_num   dbx_obj
	      fld	fn	fname	  fold	    full_name_list
	      lay_coll	lname	  lyr
	     )
  (vl-load-com)
  (setq	acapp (vlax-get-acad-object)
	adoc  (vla-get-activedocument acapp)
  )

(setq fld (getvar "filedia"))
(setvar "filedia" 0)
(setvar "SDI" 0)  
  (setq
    lname (getstring T "\nВведите имя слоя (с учетом регистра) : \n")
  )
  (setq col_num (getint "\nВведите номер цвета (например 21) : \n"))

  (setq	fn	       (getfiled "Выбрать любой DWG файл в нужной папке"
				 ""
				 "dwg"
				 8
		       )
	fold	       (vl-filename-directory fn)
	full_name_list (vl-directory-files fold "*.dwg" 1)
	full_name_list (mapcar (function (lambda (x)
					   (strcat fold "\\" x)
					 )
			       )
			       full_name_list
		       )
  )
  (foreach other full_name_list
    (setq fname (findfile other))
    (setq dbx_obj (odbx-test))
    (vla-open dbx_obj fname :vlax-false)
    (vlax-for a	(setq lay_coll (vla-get-layers dbx_obj))
      (if (not (vl-catch-all-error-p
		 (setq lyr
			(vl-catch-all-apply
			  (function (lambda ()
				      (vla-item lay_coll lname)
				    )
			  )
			)
		 )
	       )
	  )
	(vla-put-color lyr col_num)
      )
    )
    (vla-saveas dbx_obj (vla-get-name dbx_obj))
  )
  (vlax-release-object dbx_obj)
  (setq dbx_obj nil)
  (gc)
  (gc)
  (setvar "filedia" fld)
  (princ)
)
(prompt "\nВ командной строке ввести C2L \n")
(princ)
;; окончание кода

alex101000 · 01.12.2017, 13:50

Уважаемый VVA, как "прикрутить" изменение шрифта вместо работы со слоями ?

Имеется:

Код:

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

 (vl-load-com)
(defun setfont (font-name / selset)
(if (findfile font-name)
(progn
(vlax-for style
(vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-textstyles
(vl-catch-all-apply
'(lambda () (vla-put-fontfile style (findfile font-name)))
) ;_ end of VL-CATCH-ALL-APPLY
) ;_ end of vlax-for
) ;_ end of progn
) ;_ end of if
) ;_ end of defun


(defun C:cf ()
	(setfont "c:\\windows\\fonts\\ISOCPEUR.ttf")
	(redraw)
	(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
)

08.02.2006, 14:58		#1
Изменение цыета слоя в нескольких файлах elena_din Регистрация: 23.04.2005 Сообщений: 26 Подскажите, пожалуйста, возможно ли работать с содержимым файла .dwg не открывая его? Нужно поменять цвет слоя в боьшом количестве файлов. Как это можно сделать быстрее, чем меняя в каждом файле? Спасибо большое!
Просмотров: 6271

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск

	Реклама i