这个用ObjectDBX进行图纸打开批处理删除布局要怎么改才能正常运行呢？

hsx778899

2. (defun BatchProcessLayouts (directory includeSubDirs / doc dbx layouts layoutname files)
   
3.   ;; 获取目录下的所有图纸文件，包括子目录
   
4.   (defun GetAllDWGFiles (Dir Subs / _GetSubFolders)
   
5.     (defun _GetSubFolders (folder)
   
6.       (apply 'append
   
7.              (mapcar
   
8.                (function
   
9.                  (lambda (f)
   
10.                    (cons (strcat folder "\" f) (_GetSubFolders (strcat folder "\" f)))))
    
11.                (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))
    
12.     )
    
13.     (apply 'append
    
14.            (mapcar
    
15.              (function
    
16.                (lambda (filepath)
    
17.                  (mapcar
    
18.                    (function (lambda (filename) (strcat filepath "\" filename)))
    
19.                    (vl-directory-files filepath "*.dwg" 1))))
    
20.              (cons Dir (if Subs (_GetSubFolders Dir)))))
    
21.   )
    
22. 
    
23.   ;; 获取所有符合条件的图纸文件
    
24.   (setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))
    
25.   
    
26.   ;; 初始化ObjectDBX对象
    
27.   (defun OpenObjectDBXDocument (filename / dbxdoc acadapp)
    
28.     (setq acadapp (vlax-get-acad-object))
    
29.     (setq dbxdoc (vla-getinterfaceobject acadapp "ObjectDBX.AxDbDocument"))
    
30.     (vla-open dbxdoc filename)
    
31.     dbxdoc
    
32.   )
    
33.   
    
34.   ;; 批量处理文件
    
35.   (if files
    
36.     (foreach dwgfile files
    
37.       ;; 打开图纸文件使用ObjectDBX
    
38.       (setq dbx (OpenObjectDBXDocument dwgfile))
    
39.       (if dbx
    
40.         (progn
    
41.           (princ (strcat "\nProcessing file: " dwgfile))
    
42.           ;; 获取该图纸的Layouts集合
    
43.           (setq layouts (vla-get-Layouts dbx))
    
44.           ;; 遍历Layouts
    
45.           (vlax-for lout layouts
    
46.             (setq layoutname (vla-get-name lout))
    
47.             ;; 匹配条件并删除符合的Layout
    
48.             (if (or (wcmatch layoutname "A4横")
    
49.                     (wcmatch layoutname "A4竖")
    
50.                     (wcmatch layoutname "A3横")
    
51.                     (wcmatch layoutname "A3坚"))
    
52.               (progn
    
53.                 (princ (strcat "\nDeleting layout: " layoutname))
    
54.                 (vla-delete lout)
    
55.               )
    
56.             )
    
57.           )
    
58.           ;; 保存图纸（不需要显示）
    
59.           (vla-save dbx)
    
60.           ;; 释放ObjectDBX对象
    
61.           (vlax-release-object dbx)
    
62.         )
    
63.       )
    
64.     )
    
65.   )
    
66.   (princ "\nBatch operation completed.")
    
67. )
    
68. 
    
69. (defun c:BatchDeleteLayouts (/ directory includeSubDirs)
    
70.   ;; 提示用户选择是否使用当前目录或包含子目录
    
71.   (setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))
    
72.   (if (/= directory "")
    
73.     (setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))
    
74.   )
    
75.   ;; 调用批量处理函数
    
76.   (BatchProcessLayouts directory (= includeSubDirs 1))
    
77. )
    

(defun BatchProcessLayouts (directory includeSubDirs / doc dbx layouts layoutname files)<br />   ;; 获取目录下的所有图纸文件，包括子目录<br />   (defun GetAllDWGFiles (Dir Subs / _GetSubFolders)<br />     (defun _GetSubFolders (folder)<br />       (apply 'append<br />              (mapcar<br />                (function<br />                  (lambda (f)<br />                    (cons (strcat folder "\" f) (_GetSubFolders (strcat folder "\" f)))))<br />                (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))<br />     )<br />     (apply 'append<br />            (mapcar<br />              (function<br />                (lambda (filepath)<br />                  (mapcar<br />                    (function (lambda (filename) (strcat filepath "\" filename)))<br />                    (vl-directory-files filepath "*.dwg" 1))))<br />              (cons Dir (if Subs (_GetSubFolders Dir)))))<br />   )<br /> <br />   ;; 获取所有符合条件的图纸文件<br />   (setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))<br />   <br />   ;; 初始化ObjectDBX对象<br />   (defun OpenObjectDBXDocument (filename / dbxdoc acadapp)<br />     (setq acadapp (vlax-get-acad-object))<br />     (setq dbxdoc (vla-getinterfaceobject acadapp "ObjectDBX.AxDbDocument"))<br />     (vla-open dbxdoc filename)<br />     dbxdoc<br />   )<br />   <br />   ;; 批量处理文件<br />   (if files<br />     (foreach dwgfile files<br />       ;; 打开图纸文件使用ObjectDBX<br />       (setq dbx (OpenObjectDBXDocument dwgfile))<br />       (if dbx<br />         (progn<br />           (princ (strcat "\nProcessing file: " dwgfile))<br />           ;; 获取该图纸的Layouts集合<br />           (setq layouts (vla-get-Layouts dbx))<br />           ;; 遍历Layouts<br />           (vlax-for lout layouts<br />             (setq layoutname (vla-get-name lout))<br />             ;; 匹配条件并删除符合的Layout<br />             (if (or (wcmatch layoutname "A4横")<br />                     (wcmatch layoutname "A4竖")<br />                     (wcmatch layoutname "A3横")<br />                     (wcmatch layoutname "A3坚"))<br />               (progn<br />                 (princ (strcat "\nDeleting layout: " layoutname))<br />                 (vla-delete lout)<br />               )<br />             )<br />           )<br />           ;; 保存图纸（不需要显示）<br />           (vla-save dbx)<br />           ;; 释放ObjectDBX对象<br />           (vlax-release-object dbx)<br />         )<br />       )<br />     )<br />   )<br />   (princ "\nBatch operation completed.")<br /> )<br /> <br /> (defun c:BatchDeleteLayouts (/ directory includeSubDirs)<br />   ;; 提示用户选择是否使用当前目录或包含子目录<br />   (setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))<br />   (if (/= directory "")<br />     (setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))<br />   )<br />   ;; 调用批量处理函数<br />   (BatchProcessLayouts directory (= includeSubDirs 1))<br /> )<br />

运行后出现如下错误：

Include subdirectories? (1 for Yes, 0 for No): 1
；错误：Automation 错误。加载应用程序时出现问题

kozmosovia

dbx需要带版本号才能获取
(setq        key "ObjectDBX.AxDbDocument"
        val (atoi (getvar "acadver"))
  )
  (vla-GetInterfaceObject
    (vlax-get-acad-object)
    (if        (< val 16)
      key
      (strcat key "." (itoa val))
    )
  )

hsx778899

kozmosovia 发表于 2024-10-21 11:14
dbx需要带版本号才能获取
(setq        key "ObjectDBX.AxDbDocument"
        val (atoi (getvar "acadver"))

谢谢大佬的指点，现在代码改为如下

2. (defun BatchProcessLayouts (directory includeSubDirs / dbdoc files)
   
3.   ;; 获取目录下的所有图纸文件，包括子目录
   
4.   (defun GetAllDWGFiles (Dir Subs / _GetSubFolders)
   
5.     (defun _GetSubFolders (folder)
   
6.       (apply 'append
   
7.              (mapcar
   
8.                (function
   
9.                  (lambda (f)
   
10.                    (cons (strcat folder "\" f) (_GetSubFolders (strcat folder "\" f)))))
    
11.                (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))
    
12.     )
    
13.     (apply 'append
    
14.            (mapcar
    
15.              (function
    
16.                (lambda (filepath)
    
17.                  (mapcar
    
18.                    (function (lambda (filename) (strcat filepath "\" filename)))
    
19.                    (vl-directory-files filepath "*.dwg" 1))))
    
20.              (cons Dir (if Subs (_GetSubFolders Dir)))))
    
21.   )
    
22. 
    
23.   ;; 打开ObjectDBX文档的方法
    
24.   (defun OpenObjectDBXDocument (filename / dbdoc acadapp key val)
    
25.     (setq acadapp (vlax-get-acad-object))
    
26.     (setq key "ObjectDBX.AxDbDocument"
    
27.           val (atoi (getvar "ACADVER")))  ;; 获取AutoCAD版本
    
28.     ;; 根据版本号获取ObjectDBX对象
    
29.     (setq dbdoc
    
30.           (vla-GetInterfaceObject
    
31.             acadapp
    
32.             (if (< val 16)
    
33.               key
    
34.               (strcat key "." (itoa val))
    
35.             )
    
36.           )
    
37.     )
    
38.     (vla-open dbdoc filename)
    
39.     dbdoc
    
40.   )
    
41. 
    
42.   ;; 获取符合条件的图纸文件
    
43.   (setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))
    
44. 
    
45.   ;; 批量处理图纸文件
    
46.   (if files
    
47.     (foreach dwgfile files
    
48.       (setq dbdoc (OpenObjectDBXDocument dwgfile))  ;; 使用ObjectDBX打开图纸
    
49.       (if dbdoc
    
50.         (progn
    
51.           (princ (strcat "\nProcessing file: " dwgfile))
    
52.           ;; 获取Layouts集合
    
53.           (vlax-for lout (vla-get-Layouts dbdoc)
    
54.             (setq layoutname (vla-get-name lout))
    
55.             ;; 如果匹配Layout名称，删除该Layout
    
56.             (if (or (wcmatch layoutname "A4横")
    
57.                     (wcmatch layoutname "A4竖")
    
58.                     (wcmatch layoutname "A3横")
    
59.                     (wcmatch layoutname "A3坚"))
    
60.               (progn
    
61.                 (princ (strcat "\nDeleting layout: " layoutname))
    
62.                 (vla-delete lout)
    
63.               )
    
64.             )
    
65.           )
    
66.           ;; 保存更改
    
67.           (vla-save dbdoc)
    
68.           ;; 释放对象
    
69.           (vlax-release-object dbdoc)
    
70.         )
    
71.       )
    
72.     )
    
73.   )
    
74.   (princ "\nBatch operation completed.")
    
75. )
    
76. 
    
77. (defun c:BatchDeleteLayouts (/ directory includeSubDirs)
    
78.   ;; 提示用户选择目录或处理当前打开的图纸
    
79.   (setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))
    
80.   (if (/= directory "")
    
81.     (setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))
    
82.   )
    
83.   ;; 执行批量处理
    
84.   (BatchProcessLayouts directory (= includeSubDirs 1))
    
85. )
    

(defun BatchProcessLayouts (directory includeSubDirs / dbdoc files)<br />   ;; 获取目录下的所有图纸文件，包括子目录<br />   (defun GetAllDWGFiles (Dir Subs / _GetSubFolders)<br />     (defun _GetSubFolders (folder)<br />       (apply 'append<br />              (mapcar<br />                (function<br />                  (lambda (f)<br />                    (cons (strcat folder "\" f) (_GetSubFolders (strcat folder "\" f)))))<br />                (vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))<br />     )<br />     (apply 'append<br />            (mapcar<br />              (function<br />                (lambda (filepath)<br />                  (mapcar<br />                    (function (lambda (filename) (strcat filepath "\" filename)))<br />                    (vl-directory-files filepath "*.dwg" 1))))<br />              (cons Dir (if Subs (_GetSubFolders Dir)))))<br />   )<br /> <br />   ;; 打开ObjectDBX文档的方法<br />   (defun OpenObjectDBXDocument (filename / dbdoc acadapp key val)<br />     (setq acadapp (vlax-get-acad-object))<br />     (setq key "ObjectDBX.AxDbDocument"<br />           val (atoi (getvar "ACADVER")))  ;; 获取AutoCAD版本<br />     ;; 根据版本号获取ObjectDBX对象<br />     (setq dbdoc<br />           (vla-GetInterfaceObject<br />             acadapp<br />             (if (< val 16)<br />               key<br />               (strcat key "." (itoa val))<br />             )<br />           )<br />     )<br />     (vla-open dbdoc filename)<br />     dbdoc<br />   )<br /> <br />   ;; 获取符合条件的图纸文件<br />   (setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))<br /> <br />   ;; 批量处理图纸文件<br />   (if files<br />     (foreach dwgfile files<br />       (setq dbdoc (OpenObjectDBXDocument dwgfile))  ;; 使用ObjectDBX打开图纸<br />       (if dbdoc<br />         (progn<br />           (princ (strcat "\nProcessing file: " dwgfile))<br />           ;; 获取Layouts集合<br />           (vlax-for lout (vla-get-Layouts dbdoc)<br />             (setq layoutname (vla-get-name lout))<br />             ;; 如果匹配Layout名称，删除该Layout<br />             (if (or (wcmatch layoutname "A4横")<br />                     (wcmatch layoutname "A4竖")<br />                     (wcmatch layoutname "A3横")<br />                     (wcmatch layoutname "A3坚"))<br />               (progn<br />                 (princ (strcat "\nDeleting layout: " layoutname))<br />                 (vla-delete lout)<br />               )<br />             )<br />           )<br />           ;; 保存更改<br />           (vla-save dbdoc)<br />           ;; 释放对象<br />           (vlax-release-object dbdoc)<br />         )<br />       )<br />     )<br />   )<br />   (princ "\nBatch operation completed.")<br /> )<br /> <br /> (defun c:BatchDeleteLayouts (/ directory includeSubDirs)<br />   ;; 提示用户选择目录或处理当前打开的图纸<br />   (setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))<br />   (if (/= directory "")<br />     (setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))<br />   )<br />   ;; 执行批量处理<br />   (BatchProcessLayouts directory (= includeSubDirs 1))<br /> )<br />

然后又现新的错误了！！请大佬再指点下谢谢

Processing file: C:\Users\hh\Desktop\板状天线\B-13-880-960M(加拿大GLs 单极化120度）\B-13-880-960M-00(装配图)02004.dwg
Deleting layout：A3坚；错误：Automation 错误。 不存在可删除的布局
命令：

dingtiedt

是“A3坚”，还是“A3竖”

hsx778899

dingtiedt 发表于 2024-10-21 12:14
是“A3坚”，还是“A3竖”

是A3坚，图子原本就是这样写的

kozmosovia

(vla-delete lout)
改成
(vl-catch-all-apply 'vla-erase (list lout))
跳过错误继续执行

hsx778899

kozmosovia 发表于 2024-10-21 14:07
(vla-delete lout)
改成
(vl-catch-all-apply 'vla-erase (list lout))

命令: BATCHDELETELAYOUTS
Enter directory path (or leave blank for current drawings): C:\Users\hh\Desktop\板状天线
Include subdirectories? (1 for Yes, 0 for No): 1
Processing file: C:\Users\hh\Desktop\板状天线\B-13-880-960M(加拿大GLS 单极化120度)\B-13-880-960M-00(装配图)02004.dwg
Deleting layout: A3坚
Deleting layout: A4横
Deleting layout: A4竖; 错误: Automation 错误。未提供说明。
命令:

还是错误了

3278

可以调整为布局内无视口就将其删除

kozmosovia

hsx778899 发表于 2024-10-21 14:47
命令: BATCHDELETELAYOUTS
Enter directory path (or leave blank for current drawings): C:%users\hh\ ...

有可能要删除的是当前layout，推荐将当前设为Model后再删除布局