求编程：多个cad图内有多个图层，现在想要批量将所有文件按图层写出

shiyj · 发表于 2022-12-4 23:10:17

求编程：有一批cad图，内有多个图层，现在想要批量处理，将所有文件按图层写到新的文件，命名规则如：原CAD文件名+图层名.dwg。

yanshengjiang · 发表于 2022-12-4 23:10:18

然后贴上我在2011年初学时候东拼西凑的一个源码

;;;2011年11月8日 15:10:01
;;;yanshengjiang收集整理
(defun c:tcsc(/ *ERROR* la leng n dwgname lu2 lu work dwgname-lujing wenjian-ls ss);;按图层输出到文件
 (defun *ERROR*(msg)(princ))
(setvar "cmdecho" 0)
 (INITGET "All Sng")
 (setq work(getkword "\n[全图输出(A)/单一图层输出(S)] 默认(S)"))
 (if (/= "" work)(setq work "All"))
(setq la(get_all_layer))
(setq leng(length la))
(setq dwgname (getvar "dwgname"))
(setq dwgname-lujing (getvar "DWGPREFIX"))
(setq lu2(MAKEFOLDER (strcat dwgname-lujing (vl-filename-base dwgname))))
(setq lu(strcat dwgname-lujing (vl-filename-base dwgname)"\\"(vl-filename-base dwgname) "_"))
(if (= "All" work)
(progn
 (command "_.undo" "m");标记
 (command "_.zoom" "e")
 (command "_.purge" "a" "*" "n")
(setq n 0)
(while (< n leng)
(setq wenjian-ls (strcat lu (nth n la)))
 (if (= nil(findfile(strcat wenjian-ls ".dwg")))
 (if(setq ss (ssget "x" (list(cons 8 (nth n la)))))
 (progn
 (command "_.wblock" wenjian-ls "" "0,0" ss "" "oops")
 (princ "\n已经保存到: ")
 (princ wenjian-ls)
 ))
 (princ (strcat "\n已经存在" wenjian-ls ".dwg"))
 )
 (setq n(1+ n))
)
 (command "_.undo" "b");后退
 );progn
(progn
 (setq la(cdr(assoc 8(entget(car(entsel"\n请选择您要输出图层上的一个实体:"))))))
 (setq ss(ssget "x" (list(cons 8 la))))
 (if(= nil(findfile(strcat lu la ".dwg")))
 (progn
(command "_.undo" "m");标记
(command "_.zoom" "e")
 (command "_.purge" "a" "*" "n")
 (command "_.wblock" (strcat lu la) "" "0,0" ss "" "oops")
(command "_.undo" "b");后退
(princ(strcat"\n已输出到" lu la))
 )
 (princ (strcat "\n已经存在" lu la ".dwg"))
)
);progn
 );if
 (princ)
 )

;==========================================================================
 (defun get_all_layer (/ lay layer2 layname);;;;;得到图层列表。。。by秋枫批打
(setq layer2 nil
 lay (tblnext "LAYER" T)
)
(while (/= lay nil)
 (setq layname (cdr (assoc 2 lay))
 layer2 (cons layname layer2)
 )
 (setq lay (tblnext "LAYER"))
)
(setq layer2 (ACAD_Strlsort layer2))
layer2
)
;==========================================================================
(defun MAKEFOLDER (FNAME / SYS FOLDER);建立文件夹；;;By LUCAS(龙龙仔)
(if (not (findfile FNAME))
 (progn
 (setq SYS (vlax-create-object "Scripting.FileSystemObject"))
 (setq FOLDER (vlax-invoke-method SYS 'CREATEFOLDER FNAME))
 (vlax-put FOLDER
"Attributes"
1 ;此处如果改成2.则创建隐藏文件夹
 )
 (vlax-release-object FOLDER)
 (vlax-release-object SYS)
 )
;;; (alert (strcat "\"" FNAME "\" 档案夹已存在!!"))
)
(princ)
)

yanshengjiang · 发表于 2022-12-8 16:16:40

转发z版的一个源码

(vl-load-com)
;按层存文件明经 ZZXXQQ 2011.1.6 ，nuist 2015.12.18
(defun c:tt ()
  (setvar "CMDECHO" 0)
  (setq lnm nil)
  (setq filepath (strcat (vla-get-Path (vla-get-ActiveDocument (vlax-get-acad-object))) "\\") )
  (setq filepath (strcat (strcat filepath (getvar "dwgname")) "1\\") )
  (command "sh" (strcat "rd/s/q " filepath))
  (command "sh" (strcat "md " filepath))
  (while (setq lnm (tblnext "LAYER" (not lnm)))
(if (setq ss (ssget "X" (list (cons 8 (cdr(assoc 2 lnm))))))
   (command ".WBLOCK" (strcat (strcat filepath (cdr(assoc 2 lnm))) ".dxf") "" "" "0,0" ss "")
)
  )
  (setvar "CMDECHO" 1)
  (princ)
)

shiyj · 发表于 2022-12-8 22:37:33

本帖最后由 shiyj 于 2022-12-8 22:39 编辑

(defun c:ltt ()
(setvar "CMDECHO" 0)
(setq newpath (strcat (getvar "DWGPREFIX") "out") )
(if (= (vl-file-directory-p newpath)  nil)  (vl-mkdir newpath))
(setq lnm nil)
(while (setq lnm (tblnext "LAYER" (not lnm))  )
  (if (setq ss  (ssget "X"  (list (cons 8 (cdr (assoc 2 lnm) ) )  )  )  )
   (command ".WBLOCK"  (strcat newpath "\\" (vl-filename-base  (getvar  "DWGNAME" )) "-"  (cdr (assoc  2  lnm)))  "" "0,0" ss "" "oops")
      )
)
(setvar "CMDECHO" 1)
(princ)
)

shiyj · 发表于 2022-12-8 22:44:43

本帖最后由 shiyj 于 2022-12-8 22:47 编辑

yanshengjiang 发表于 2022-12-8 16:16
转发z版的一个源码

(vl-load-com)

感谢回复。之前借鉴Z版代码了，程序不能批处理一个文件夹，还需要用批处理工具，再一个需要打开文件才能处理，速度不是很快。

llsheng_73 · 发表于 2022-12-9 09:51:15

本帖最后由 llsheng_73 于 2022-12-10 13:45 编辑

(defun GetFolder(msg / WinShell shFolder path catchit);选取文件夹
(setq shFolder(vlax-invoke-method (vlax-create-object "Shell.Application")'BrowseForFolder 0 msg 1))
(setq catchit(vl-catch-all-apply'(lambda()(setq shFolder(vlax-get-property shFolder'self))
(setq path(vlax-get-property shFolder'path)))))
(if(vl-catch-all-error-p catchit)nil path))
(defun xdirectory(folder)
(setq folder(list(list folder)))
(while(car(setq folder(cons(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x"\\"y))(cddr(vl-directory-files X nil -1))))
(car folder)))folder))))(apply'append folder))
(defun getpath(msg ext / path paths files)
(and(setq path(GETFOLDER msg))
(setq paths(XDIRECTORY path))
(setq files(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x "\\"y))(VL-DIRECTORY-FILES x ext 1)))paths)))
)(list paths files))
(defun l2array(l / A)
(vlax-safearray-fill(vlax-make-safearray 9(cons 0(1-(length l))))
(mapcar(function(lambda(x / a)(setq a(type x))(cond((='ename a)(vlax-ename->vla-object x))((='VLA-OBJECT a)x))))l)))
(defun c:tt(/ files acad layers *DBX *Dbmdl blk doc blkname acVer)
(vl-load-com)
(setq acad(vlax-get-acad-object)
doc(vlax-get-property acad'activedocument)
acVer(atoi(getvar "ACADVER"))
*DBX(vla-GetInterfaceObject *ACAD(if(< acVer 16)"ObjectDBX.AxDbDocument"(strcat"ObjectDBX.AxDbDocument."(itoa acVer))))
*Dbmdl(vla-get-ModelSpace *dbxobj)
blk(vlax-invoke-method(vlax-get-property doc'blocks)'add(vlax-3d-point 0 0)"*U")
blkname(vlax-get-property blk'name))
(and(setq files(cadr(GETPATH"指定要合并的Excel文件夹""*.dwg")))
(vl-some(function(lambda(x / lays la lay)
(vlax-for x blk(vlax-invoke-method x 'delete))
(and(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(List(*DBX"open"x)))))
(vlax-for x(vlax-get-property *DBX'layers)(setq lays(cons(list(vlax-get-property x 'name))lays)))
(vlax-for x *Dbmdl
(setq la(assoc(vlax-get-property x'layer)lays)lays(cons(vl-list*(car la)x(cdr la))(vl-remove la lays))))
(vl-some(function(lambda(a)
(and(cadr a)
(vlax-invoke-method doc'wblock(strcat(VL-FILENAME-DIRECTORY x)(VL-FILENAME-base x)(car a)".dwg")
(vlax-invoke-method *DBX'CopyObjects(l2array(cdr a))))
nil)))lays))))
files))
(vlax-invoke-method blk 'delete))

(defun GetFolder(msg / WinShell shFolder path catchit);选取文件夹 
  (setq shFolder(vlax-invoke-method (vlax-create-object "Shell.Application")'BrowseForFolder 0 msg 1)) 
  (setq  catchit(vl-catch-all-apply'(lambda()(setq shFolder(vlax-get-property shFolder'self)) 
                                      (setq path(vlax-get-property shFolder'path))))) 
  (if(vl-catch-all-error-p catchit)nil path)) 
(defun xdirectory(folder) 
  (setq folder(list(list folder))) 
  (while(car(setq folder(cons(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x"\\"y))(cddr(vl-directory-files X nil -1)))) 
                                                 (car folder)))folder))))(apply'append folder)) 
(defun getpath(msg ext / path paths files) 
  (and(setq path(GETFOLDER msg)) 
      (setq paths(XDIRECTORY path)) 
      (setq files(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x "\\"y))(VL-DIRECTORY-FILES x ext 1)))paths))) 
      )(list paths files)) 
(defun l2array(l / A) 
  (vlax-safearray-fill(vlax-make-safearray 9(cons 0(1-(length l)))) 
    (mapcar(function(lambda(x / a)(setq a(type x))(cond((='ename a)(vlax-ename->vla-object x))((='VLA-OBJECT a)x))))l))) 
(defun c:tt(/ files acad layers *DBX *Dbmdl blk doc blkname acVer) 
  (vl-load-com) 
  (setq acad(vlax-get-acad-object) 
        doc(vlax-get-property acad'activedocument) 
        acVer(atoi(getvar "ACADVER")) 
        *DBX(vla-GetInterfaceObject *ACAD(if(< acVer 16)"ObjectDBX.AxDbDocument"(strcat"ObjectDBX.AxDbDocument."(itoa acVer)))) 
        *Dbmdl(vla-get-ModelSpace *dbxobj) 
        blk(vlax-invoke-method(vlax-get-property doc'blocks)'add(vlax-3d-point 0 0)"*U") 
        blkname(vlax-get-property blk'name)) 
  (and(setq files(cadr(GETPATH"指定要合并的Excel文件夹""*.dwg"))) 
      (vl-some(function(lambda(x / lays la lay) 
                         (vlax-for x blk(vlax-invoke-method x 'delete)) 
                         (and(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY(function vlax-invoke-method)(List(*DBX"open"x))))) 
                             (vlax-for x(vlax-get-property *DBX'layers)(setq lays(cons(list(vlax-get-property x 'name))lays))) 
                             (vlax-for x *Dbmdl 
                               (setq la(assoc(vlax-get-property x'layer)lays)lays(cons(vl-list*(car la)x(cdr la))(vl-remove la lays)))) 
                             (vl-some(function(lambda(a) 
                                                (and(cadr a) 
                                                    (vlax-invoke-method doc'wblock(strcat(VL-FILENAME-DIRECTORY x)(VL-FILENAME-base x)(car a)".dwg") 
                                                      (vlax-invoke-method *DBX'CopyObjects(l2array(cdr a)))) 
                                                    nil)))lays)))) 
              files)) 
  (vlax-invoke-method blk 'delete))

未来得及测试

shiyj · 发表于 2022-12-9 23:52:50

llsheng_73 发表于 2022-12-9 09:51
未来得及测试

不懂就问，第33行代码中有一句 (car la x) ，好像car参数只有一个：表，为甚能有两个参数？

llsheng_73 · 发表于 2022-12-10 13:43:46

本帖最后由 llsheng_73 于 2022-12-10 13:46 编辑

shiyj 发表于 2022-12-9 23:52
不懂就问，第33行代码中有一句 (car la x) ，好像car参数只有一个：表，为甚能有两个参数？

没注意到。写错了

已更正

shiyj · 发表于 2022-12-11 12:35:13

本帖最后由 shiyj 于 2022-12-11 12:38 编辑

大佬，你的代码我使劲调试还是不能运行，提示：参数类型错误: VLA-OBJECT nil 能否抽个使劲帮忙试运行一次。

账号		自动登录	找回密码
密码			注册

[提问] 求编程：多个cad图内有多个图层，现在想要批量将所有文件按图层写出

最佳答案

评分

本帖子中包含更多资源