（请大家来测试）如何批量修改文件夹里面的多张图纸里的线层？（不打开图纸）

qcw911

我现在的工作就是将很多dwg里面的线性换成指定的线性，工作重复
如何在不打开文件的情况下批量处理呢


内容如下
1、文件夹里面有很多dwg
2、批量的将文件夹里面的dwg里面的线层换成相应的线层   
例如 线层：txt→ tom_txt、 block→ tom_block
lisp能实现吗？
请高手讨论。
我来学习学习

e2002

DBX 试试吧

Andyhon

没试过
您可搜寻龙版主有关ObjectDbx的帖子

masterlong

;|
1。核心代码来自gu_xl的不开图修改文字的程序
2。自行安装dos_lib函数库，本站有下载
3。自建一个c:\qgy_temp的文件夹
4。自行修改程序末尾的替换图层名列表
|;


;;PGP : chlay
(defun RegObjectDBX (/ DBXSERVER)   ;by Tony Tanzillo
(cond
  ((vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID")
  )
  ((not (setq DBXSERVER (findfile "AxDb15.dll")))
   (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
  )
  ( T
   (startapp "regsvr32.exe" (strcat "/s \"" DBXSERVER "\""))
   (or (vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
   (alert "Error: Failed to register ObjectDBX ActiveX services.")
  )
)
)
(defun replace_lay_main()
(setq layers (vla-get-layers DBXDOC))
(vlax-for layer layers
  (setq lay (vla-get-name layer))
  (if (assoc lay layerlist)
   (vla-put-Name layer (cdr (assoc lay layerlist)))
  )
)
)
(defun yuuboo-DBX-Replacelayer ( layerlist DwgName /  RegObjectDBX  DBXModelSpace  DBXDOC )
(setq *ACAD* (vlax-get-acad-object)
  *AcDocument* (vla-get-activedocument *Acad*)
  *Model-Space* (vla-get-modelspace *AcDocument*)
)
  (setq DwgName (findfile DwgName))
  (if DwgName
  (progn
   (if (= "15" (substr (getvar "acadver") 1 2))
    (progn
     (if (not (RegObjectDBX))
      (exit)
     )
     (setq DBXDOC (vla-getinterfaceobject *ACAD* "ObjectDBX.AxDbDocument"))
    )
    (setq DBXDOC (vla-getinterfaceobject *ACAD* "ObjectDBX.AxDbDocument.16"))
   )
   (setq FileName (strcat (getvar "dwgprefix") (getvar "dwgname")))
   (if (equal (strcase FileName) (strcase DWGNAME))
    (setq DBXModelSpace *MODEL-SPACE*
     DBXDOC *ACDOCUMENT*
    )
    (progn
     (vla-open DBXDOC DWGNAME)
     (setq DBXModelSpace (vla-get-ModelSpace DBXDOC))
    )
   )
(replace_lay_main)
   (if (equal (strcase FileName) (strcase DWGNAME))
    (vla-Save *AcDocument*)
    (vla-Saveas DBXDOC DWGNAME)
   )
   ;;(vlax-release-object DBXDOC)
  )
  )
)

(defun keep_chlay()
(setq mydir (vlax-ldata-get "chlay" "mydir"))
(setq i (1+ (setq errdwgid (vlax-ldata-get "chlay" "errdwgid"))))
(setq ppp (open (strcat mydir "mydwg.txt") "r"))
(princ "\n")
(repeat errdwgid (read-line ppp))
(while (setq dwg (read-line ppp))
  (princ (strcat "\r" dwg "                                                                 "))
  (vlax-ldata-put "chlay" "errdwgid" i)
  (yuuboo-DBX-Replacelayer layerlist dwg)
  (setq i (1+ i))
)
(close ppp)
(vlax-ldata-delete "chlay" "mydir")
(vlax-ldata-delete "chlay" "errdwgid")
(dos_command (strcat "del " mydir "*.bak /s") 3)
(dos_command (strcat "del " mydir "*.dwl /s") 3)
)

(defun sel_new_dir_for_chlay()
(setq testdir "C:\\")
(setq mydir (dos_getdir "选择替换文件夹"  testdir))
(vlax-ldata-put "chlay" "mydir" mydir)
(dos_command (strcat "dir " mydir "*.dwg /s/o/b >"  mydir "mydwg.txt") 1)
(repeat 3000000 (princ))
;;这句不可用，为什么？？？(dos_exewait (strcat "shell dir " mydir "*.dwg /s/o/b >"  mydir "mydwg.txt") 2)
(setq ppp (open (strcat mydir "mydwg.txt") "r"))
(princ "\n")
(setq i 0)
(while (setq dwg (read-line ppp))
  (princ (strcat "\r" dwg "                                                                 "))
  (vlax-ldata-put "chlay" "errdwgid" i)
  (yuuboo-DBX-Replacelayer layerlist dwg)
  (setq i (1+ i))
)
(close ppp)
(vlax-ldata-delete "chlay" "mydir")
(vlax-ldata-delete "chlay" "errdwgid")
(dos_command (strcat "del " mydir "*.bak /s") 3)
(dos_command (strcat "del " mydir "*.dwl /s") 3)
)
(defun time_start()
(setq *time_start* (getvar "cdate"))
)
(defun time_end()
(setq *time_end* (getvar "cdate"))
(princ "\n 程序运行完成   耗时 ")(princ (* 1000000 (- *time_end* *time_start*)))(princ " 秒")(princ)
)
(defun chlay_err()
(setvar "cmdecho" 0)
(command "undo" "g")
(setq olderr *error* )

;|
   (defun *error*(msg)
    (setq *error* olderr)
  (chlay_main)
   (princ)
   )
   |;

   (defun *error*(msg)
  (setq *error* olderr)
  (setq @x_scr (open "c:\\QGY_temp\\@x_scr.scr" "w"))
  (write-line "chlay" @x_scr)
  (close @x_scr)
  (command "script" "c:\\QGY_temp\\@x_scr.scr")
)
   (defun no_err()
  (command "undo" "e")
  (setq *error* olderr)
   (princ)
   )
(princ)
)
(defun chlay_main()
(if (null (vlax-ldata-get "chlay" "mydir"))
  (sel_new_dir_for_chlay)
  (keep_chlay)
)
(princ)
)
;;;调用命令：chlay
(defun c:chlay ()
(chlay_err)
(if (null $$$)
  (progn (setq $$$ T)(time_start))
)
(setq layerlist
   (list (cons  "线槽"    "j_线槽")
     (cons  "线槽中心线"  "j_线槽中心线")
     (cons  "桥架"    "j_桥架")
   )
)
(chlay_main)
(setq $$$ Nil)
(time_end)
(no_err)
(princ)
)

qcw911

masterlong 发表于 2010-12-24 22:50
;|
1。核心代码来自gu_xl的不开图修改文字的程序
2。自行安装dos_lib函数库，本站有下载

谢谢 masterlong

qcw911

masterlong 发表于 2010-12-24 22:50
;|
1。核心代码来自gu_xl的不开图修改文字的程序
2。自行安装dos_lib函数库，本站有下载

哎呀，真有啊
谢谢 masterlong
是附件这个文件吗？
但是我加载后 运行程序
chlay

不断重复运行
命令: chlay
命令: chlay
命令: chlay
命令: chlay
命令: chlay
命令: chlay
命令: chlay
。。。。。。

ESC 才能退出
我用的是2004CAD
这是为什么呢

masterlong

我的这个程序是编来自用的
因为某些特殊的原因
对*error*做了些特殊处理
具体的原因见这个帖子
http://bbs.mjtd.com/forum.php?mo ... 2759&highlight=
这里就不细说了

masterlong

呃
加载了这个程序运行了下
也出现了楼主说的情况
可能这是个未完成版本
完成版本在办公室的机子里
楼主要不急的话
等礼拜1吧

masterlong

恩
楼主注意看下你的文件夹路径里是否含有空格？
我这里没空格的时候是可以运行的

qcw911

前辈拜托了，我是新手，对你的程序 看的不是十分明白
没有高手的修改能力，
希望帮帮忙 教我如何调整 和使用。

不知我下载的那个文件是不是你所说的数据库。