这个用ObjectDBX进行图纸打开批处理删除布局要怎么改才能正常运行呢？
(defun BatchProcessLayouts (directory includeSubDirs / doc dbx layouts layoutname files);; 获取目录下的所有图纸文件，包括子目录
(defun GetAllDWGFiles (Dir Subs / _GetSubFolders)
(defun _GetSubFolders (folder)
(apply 'append
(mapcar
(function
(lambda (f)
(cons (strcat folder "\\" f) (_GetSubFolders (strcat folder "\\" f)))))
(vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))
)
(apply 'append
(mapcar
(function
(lambda (filepath)
(mapcar
(function (lambda (filename) (strcat filepath "\\" filename)))
(vl-directory-files filepath "*.dwg" 1))))
(cons Dir (if Subs (_GetSubFolders Dir)))))
)
;; 获取所有符合条件的图纸文件
(setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))
;; 初始化ObjectDBX对象
(defun OpenObjectDBXDocument (filename / dbxdoc acadapp)
(setq acadapp (vlax-get-acad-object))
(setq dbxdoc (vla-getinterfaceobject acadapp "ObjectDBX.AxDbDocument"))
(vla-open dbxdoc filename)
dbxdoc
)
;; 批量处理文件
(if files
(foreach dwgfile files
;; 打开图纸文件使用ObjectDBX
(setq dbx (OpenObjectDBXDocument dwgfile))
(if dbx
(progn
(princ (strcat "\nProcessing file: " dwgfile))
;; 获取该图纸的Layouts集合
(setq layouts (vla-get-Layouts dbx))
;; 遍历Layouts
(vlax-for lout layouts
(setq layoutname (vla-get-name lout))
;; 匹配条件并删除符合的Layout
(if (or (wcmatch layoutname "A4横")
(wcmatch layoutname "A4竖")
(wcmatch layoutname "A3横")
(wcmatch layoutname "A3坚"))
(progn
(princ (strcat "\nDeleting layout: " layoutname))
(vla-delete lout)
)
)
)
;; 保存图纸（不需要显示）
(vla-save dbx)
;; 释放ObjectDBX对象
(vlax-release-object dbx)
)
)
)
)
(princ "\nBatch operation completed.")
)
(defun c:BatchDeleteLayouts (/ directory includeSubDirs)
;; 提示用户选择是否使用当前目录或包含子目录
(setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))
(if (/= directory "")
(setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))
)
;; 调用批量处理函数
(BatchProcessLayouts directory (= includeSubDirs 1))
)
运行后出现如下错误：
Include subdirectories? (1 for Yes, 0 for No): 1
；错误：Automation 错误。加载应用程序时出现问题
dbx需要带版本号才能获取
(setq key "ObjectDBX.AxDbDocument"
val (atoi (getvar "acadver"))
)
(vla-GetInterfaceObject
(vlax-get-acad-object)
(if (< val 16)
key
(strcat key "." (itoa val))
)
) kozmosovia 发表于 2024-10-21 11:14
dbx需要带版本号才能获取
(setq key "ObjectDBX.AxDbDocument"
val (atoi (getvar "acadver"))
谢谢大佬的指点，现在代码改为如下
(defun BatchProcessLayouts (directory includeSubDirs / dbdoc files)
;; 获取目录下的所有图纸文件，包括子目录
(defun GetAllDWGFiles (Dir Subs / _GetSubFolders)
(defun _GetSubFolders (folder)
(apply 'append
(mapcar
(function
(lambda (f)
(cons (strcat folder "\\" f) (_GetSubFolders (strcat folder "\\" f)))))
(vl-remove "." (vl-remove ".." (vl-directory-files folder nil -1)))))
)
(apply 'append
(mapcar
(function
(lambda (filepath)
(mapcar
(function (lambda (filename) (strcat filepath "\\" filename)))
(vl-directory-files filepath "*.dwg" 1))))
(cons Dir (if Subs (_GetSubFolders Dir)))))
)
;; 打开ObjectDBX文档的方法
(defun OpenObjectDBXDocument (filename / dbdoc acadapp key val)
(setq acadapp (vlax-get-acad-object))
(setq key "ObjectDBX.AxDbDocument"
val (atoi (getvar "ACADVER")));; 获取AutoCAD版本
;; 根据版本号获取ObjectDBX对象
(setq dbdoc
(vla-GetInterfaceObject
acadapp
(if (< val 16)
key
(strcat key "." (itoa val))
)
)
)
(vla-open dbdoc filename)
dbdoc
)
;; 获取符合条件的图纸文件
(setq files (if directory (GetAllDWGFiles directory includeSubDirs) nil))
;; 批量处理图纸文件
(if files
(foreach dwgfile files
(setq dbdoc (OpenObjectDBXDocument dwgfile));; 使用ObjectDBX打开图纸
(if dbdoc
(progn
(princ (strcat "\nProcessing file: " dwgfile))
;; 获取Layouts集合
(vlax-for lout (vla-get-Layouts dbdoc)
(setq layoutname (vla-get-name lout))
;; 如果匹配Layout名称，删除该Layout
(if (or (wcmatch layoutname "A4横")
(wcmatch layoutname "A4竖")
(wcmatch layoutname "A3横")
(wcmatch layoutname "A3坚"))
(progn
(princ (strcat "\nDeleting layout: " layoutname))
(vla-delete lout)
)
)
)
;; 保存更改
(vla-save dbdoc)
;; 释放对象
(vlax-release-object dbdoc)
)
)
)
)
(princ "\nBatch operation completed.")
)
(defun c:BatchDeleteLayouts (/ directory includeSubDirs)
;; 提示用户选择目录或处理当前打开的图纸
(setq directory (getstring "\nEnter directory path (or leave blank for current drawings): "))
(if (/= directory "")
(setq includeSubDirs (getint "\nInclude subdirectories? (1 for Yes, 0 for No): "))
)
;; 执行批量处理
(BatchProcessLayouts directory (= includeSubDirs 1))
)
然后又现新的错误了！！请大佬再指点下谢谢
Processing file: C:\Users\hh\Desktop\板状天线\B-13-880-960M(加拿大GLs 单极化120度）\B-13-880-960M-00(装配图)02004.dwg
Deleting layout：A3坚；错误：Automation 错误。 不存在可删除的布局
命令： 是“A3坚”，还是“A3竖” dingtiedt 发表于 2024-10-21 12:14
是“A3坚”，还是“A3竖”
是A3坚，图子原本就是这样写的:D- (vla-delete lout)
改成
(vl-catch-all-apply 'vla-erase (list lout))
跳过错误继续执行 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 错误。未提供说明。
命令:
还是错误了 可以调整为布局内无视口就将其删除 hsx778899 发表于 2024-10-21 14:47
命令: BATCHDELETELAYOUTS
Enter directory path (or leave blank for current drawings): C:%users\hh\ ...
有可能要删除的是当前layout，推荐将当前设为Model后再删除布局
页:
[1]