批量合并图纸又快又避免同名块影响,AI编写的
批量合并图纸又快又避免同名块影响AI编写的，一遍成活
经多次测试从5个图到100个图，均很快，且能自动避免同名块的影响
本帖最后由 qifeifei 于 2025-11-1 13:55 编辑
DCL和LSP源码文件在此，程序非常好用，但有几个小问题：
1、程序在每打开的一幅图中只能用一次，再次用就出错 【已修复】
2、程序用过后，保存图时被改为不能调用对话框选择路径，感觉是改了那个系统变量 【已修复】
3、程序结束后要有个运行时间就好了。【已修复】
用Qwen修好的；Qwen肯定没有claude好；毋庸置疑；但是qwen写lisp还是有点东西的
感谢Qwen的修复
-------------
qifeifei 发表于 2025-10-31 22:31
写lisp这种非热门代码、体验最好的是qwen
谢谢你的介绍
经测试，相同的提问，从头到尾
四五次修改都没有一次可用的
感觉还是差距大哈
ai的代码 还有不少问题 排版还是有问题
;;; MergeLayouts.lsp
;;; 功能：合并多个布局到一个布局（支持块图框 + 多视口）
;;; 兼容 AutoCAD 2012 – 2024 标准版（无需 DCL，无 vl-choice-list）
(vl-load-com)
; 快捷命令
(defun c:tt2 () (c:MergeLayouts))
(defun c:tr2 () (c:MergeLayouts))
(princ "\n命令已加载，输入 SIDECUT 或 tt2 启动")
(princ)
;;; MergeLayouts.lsp
;;; 功能：合并多个布局到一个布局（支持块图框 + 多视口）
;;; 兼容 AutoCAD 2012 – 2024 标准版 | 无 DCL | 无第三方依赖
;;; MergeLayouts.lsp
;;; 功能：合并多个布局到一个布局（支持块图框 + 多视口）
;;; 兼容 AutoCAD 2012 – 2024 标准版 | 无 DCL | 自动创建视口
(vl-load-com)
(defun c:MergeLayouts (/ doc layouts allLayoutNames srcNames tgtName
delSrc? cols row col basePt offsetVec
entsToCopy bbox width height newInsertPt layoutObj
input indices)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq layouts (vla-get-Layouts doc))
;; 获取所有非 Model 布局名称
(setq allLayoutNames '())
(vlax-for layout layouts
(setq layName (vla-get-Name layout))
(if (/= (strcase layName) "MODEL")
(setq allLayoutNames (cons layName allLayoutNames))
)
)
(setq allLayoutNames (reverse allLayoutNames))
;; 检查布局数量
(if (< (length allLayoutNames) 2)
(progn
(alert "至少需要两个布局（不含 Model）才能合并！")
(princ)
(exit)
)
)
;; ========== 选择源布局（编号多选）==========
(princ "\n可用布局列表:")
(setq i 0)
(foreach name allLayoutNames
(princ (strcat "\n[" (itoa (setq i (1+ i))) "] " name))
)
(princ "\n\n请输入要合并的源布局编号（空格分隔，例如: 1 3 4）: ")
(setq input (getstring T))
(if (= input "") (exit))
;; 安全解析输入
(if (wcmatch (strcat " " input " ") "*[~ 0-9 ]*")
(progn
(alert "输入格式错误！\n请只输入数字，用空格分隔（如: 1 2 3）。")
(exit)
)
)
(setq indices (read (strcat "(" (vl-string-trim " " input) ")")))
(if (atom indices) (setq indices (list indices)))
(setq srcNames
(vl-remove-if-not
'(lambda (idx) (and (>= idx 1) (<= idx (length allLayoutNames))))
indices
)
)
(if (null srcNames)
(progn (alert "未选择任何有效布局！") (exit))
)
(setq srcNames
(mapcar '(lambda (i) (nth (1- i) allLayoutNames)) srcNames)
)
;; ========== 源布局选择结束 ==========
;; ========== 选择目标布局 ==========
(setq candidates (vl-remove-if '(lambda (x) (member x srcNames)) allLayoutNames))
(cond
(candidates
(princ "\n可选目标布局:")
(setq i 0)
(foreach name candidates
(princ (strcat "\n[" (itoa (setq i (1+ i))) "] " name))
)
(princ "\n\n输入目标布局编号，或直接回车新建布局: ")
(setq input (getstring T))
(if (= input "")
(setq tgtName (getstring "\n输入新布局名称 <Merged_Layout>: "))
(progn
(if (wcmatch input "*[~0-9]*")
(setq tgtName "Merged_Layout")
(progn
(setq idx (atoi input))
(if (and (>= idx 1) (<= idx (length candidates)))
(setq tgtName (nth (1- idx) candidates))
(setq tgtName "Merged_Layout")
)
)
)
)
)
)
(T
(setq tgtName (getstring "\n输入新布局名称 <Merged_Layout>: "))
)
)
(if (= tgtName "") (setq tgtName "Merged_Layout"))
;; 创建目标布局（如果不存在）
(if (not (member tgtName allLayoutNames))
(vla-Add layouts tgtName)
)
;; ✅ 关键修正：确保目标布局有活动视口
(EnsureActiveViewport tgtName)
;; 是否删除源布局？
(initget "是 否")
(setq delSrc?
(= (getkword "\n是否删除源布局？[是/否] <否>: ") "是")
)
;; 清空目标布局（保留一个视口）
(ClearLayout tgtName)
;; ========== 合并处理 ==========
(setq cols 2) ; 每行布局数量
(setq row 0)
(setq col 0)
(foreach layName srcNames
(princ (strcat "\n正在处理布局: " layName))
(setq layoutObj (vla-Item layouts layName))
(setq entsToCopy (ssget "_X" (list (cons 410 layName))))
(if entsToCopy
(progn
(setq basePt (GetFrameBasePoint entsToCopy))
(if (null basePt) (setq basePt '(0.0 0.0 0.0)))
(setq bbox (GetLayoutBoundingBox entsToCopy))
(if bbox
(progn
(setq width (- (car (cadr bbox)) (car (car bbox))))
(setq height (- (cadr (cadr bbox)) (cadr (car bbox))))
)
(progn
(setq width 1189.0) ; A3 宽 (mm)
(setq height 841.0) ; A3 高 (mm)
)
)
(setq newInsertPt
(list
(+ (* col (+ width 20.0)) 10.0)
(- (* row (+ height 20.0)) 10.0)
0.0
)
)
(setq offsetVec (mapcar '- newInsertPt basePt))
(CopyAndMoveEntities entsToCopy tgtName offsetVec)
)
)
(setq col (1+ col))
(if (>= col cols) (setq col 0 row (1+ row)))
(if delSrc? (vla-Delete layoutObj))
)
(setvar "CTAB" tgtName)
(princ (strcat "\n✅ 合并完成！目标布局: " tgtName))
(princ)
)
;; ========== 确保布局有活动视口 ==========
(defun EnsureActiveViewport (layName / doc layouts)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq layouts (vla-get-Layouts doc))
;; 切换到目标布局
(setvar "CTAB" layName)
;; 检查是否存在视口
(setq hasViewport nil)
(vlax-for obj (vla-get-Block (vla-Item layouts layName))
(if (= (vla-get-ObjectName obj) "AcDbViewport")
(setq hasViewport T)
)
)
;; 如果没有视口，创建默认视口
(if (not hasViewport)
(progn
(princ (strcat "\n⚠️ 布局 " layName " 无视口，正在创建默认视口..."))
(command "_.MVIEW" "_FIT")
;; 等待命令完成
(while (> (getvar "CMDACTIVE") 0)
(command)
)
)
)
)
;; ========== 安全获取点坐标 ==========
(defun GetPointSafe (obj prop / pt)
(setq pt (vlax-get obj prop))
(cond
((listp pt) pt)
((= (type pt) 'variant)
(vlax-safearray->list (vlax-variant-value pt))
)
(T nil)
)
)
;; ========== 获取图框块插入点 ==========
(defun GetFrameBasePoint (ss / i ent obj pt)
(setq i 0 pt nil)
(repeat (sslength ss)
(if (null pt)
(progn
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(setq pt (GetPointSafe obj 'InsertionPoint))
)
)
)
(setq i (1+ i))
)
pt
)
;; ========== 获取布局包围盒 ==========
(defun GetLayoutBoundingBox (ss / minPt maxPt globalMin globalMax i ent obj)
(setq i 0 globalMin nil globalMax nil)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(if (not (wcmatch (vla-get-ObjectName obj) "*Viewport"))
(progn
(vla-GetBoundingBox obj 'minPt 'maxPt)
(if (null globalMin)
(setq globalMin minPt globalMax maxPt)
(progn
(setq globalMin (MapMinMax globalMin minPt 'min))
(setq globalMax (MapMinMax globalMax maxPt 'max))
)
)
)
)
(setq i (1+ i))
)
(if globalMin
(list
(vlax-safearray->list globalMin)
(vlax-safearray->list globalMax)
)
)
)
;; ========== 向量 min/max ==========
(defun MapMinMax (v1 v2 op / x1 y1 z1 x2 y2 z2)
(setq x1 (vlax-safearray-get-element v1 0)
y1 (vlax-safearray-get-element v1 1)
z1 (vlax-safearray-get-element v1 2)
x2 (vlax-safearray-get-element v2 0)
y2 (vlax-safearray-get-element v2 1)
z2 (vlax-safearray-get-element v2 2)
)
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 2))
(list
((if (= op 'min) min max) x1 x2)
((if (= op 'min) min max) y1 y2)
((if (= op 'min) min max) z1 z2)
)
)
)
;; ========== 复制并移动实体 ==========
(defun CopyAndMoveEntities (ss tgtLayoutName offset / oldCTAB i ent obj newEnt doc)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq oldCTAB (getvar "CTAB"))
(setvar "CTAB" tgtLayoutName)
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
;; 跳过主视口：保留第一个视口（由 ClearLayout 保证存在）
(if (/= (vla-get-ObjectName obj) "AcDbViewport")
(progn
(setq newEnt (vla-Copy obj))
(vla-Move newEnt (vlax-3d-point '(0 0 0)) (vlax-3d-point offset))
)
;; 视口也复制（但 ClearLayout 已清空，所以这里不会重复）
(progn
(setq newEnt (vla-Copy obj))
(vla-Move newEnt (vlax-3d-point '(0 0 0)) (vlax-3d-point offset))
)
)
(setq i (1+ i))
)
(setvar "CTAB" oldCTAB)
)
;; ========== 清空布局（保留第一个视口）==========
(defun ClearLayout (layName / oldCTAB doc layoutObj firstVP ss i ent obj)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq oldCTAB (getvar "CTAB"))
(setvar "CTAB" layName)
(setq layoutObj (vla-Item (vla-get-Layouts doc) layName))
;; 找到第一个视口（用于保留）
(setq firstVP nil)
(vlax-for obj (vla-get-Block layoutObj)
(if (and (= (vla-get-ObjectName obj) "AcDbViewport") (null firstVP))
(setq firstVP obj)
)
)
;; 删除所有实体，除了第一个视口
(setq ss (ssget "_X" (list (cons 410 layName))))
(if ss
(progn
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(if (or (/= (vla-get-ObjectName obj) "AcDbViewport")
(/= obj firstVP))
(vla-delete obj)
)
(setq i (1+ i))
)
)
)
(setvar "CTAB" oldCTAB)
)
;; ========== 字符串工具 ==========
(defun vl-string-trim (chars str / len)
(while (and (> (strlen str) 0) (vl-position (ascii (substr str 1 1)) (vl-string->list chars)))
(setq str (substr str 2))
)
(while (and (> (strlen str) 0) (vl-position (ascii (substr str (strlen str) 1)) (vl-string->list chars)))
(setq str (substr str 1 (1- (strlen str))))
)
str
)
(defun vl-string->list (str / i lst)
(setq i 0 lst '())
(while (< i (strlen str))
(setq lst (cons (ascii (substr str (setq i (1+ i)) 1)) lst))
)
(reverse lst)
)
(princ "\n命令 MERGELAYOUTS 已加载。")
(princ "\n✅ 支持：块图框 + 多视口 + 自动创建默认视口")
(princ "\n✅ 兼容 AutoCAD 2012 – 2024 标准版")
(princ "\n📌 使用方法：输入 MERGELAYOUTS，按编号选择布局。")
(princ)
用哪个AI写的？ 这是源码和测试文件，及合并后的图
;;;------------------------------------------------------------------
;;; 程序名称: MergeDWGs.lsp
;;; 功能: 批量合并指定文件夹下的所有DWG文件到当前图形
;;; - 通过对话框选择文件夹和设置间距
;;; - 自动处理块名冲突
;;; - 自定义排列布局
;;; 作者: AI Assistant
;;; 日期: 2025-10-31
;;;------------------------------------------------------------------
;;; 主函数，在AutoCAD中输入 MERGEDWGS 来运行
(defun C:MERGEDWGS (/ dcl_id folder_path x_space y_space col_count dwg_files
ins_pt current_col max_row_height current_y old_cmdecho old_filedia)
;; --- 1. 加载和显示DCL对话框 ---
(setq dcl_path (findfile "MergeDWGs.dcl"))
(if (not dcl_path)
(progn
(alert "错误：未找到 MergeDWGs.dcl 文件！\n请确保它与LSP文件在同一目录或AutoCAD支持路径下。")
(exit)
)
)
(setq dcl_id (load_dialog dcl_path))
(if (not (new_dialog "MergeDWGsDialog" dcl_id))
(exit)
)
;; --- 2. DCL对话框事件处理 ---
;; 浏览文件夹按钮的动作
(action_tile "browse"
"(setq folder_path (get_folder))
(if folder_path
(set_tile \"folder_path\" folder_path)
)"
)
;; 确定按钮的动作
(action_tile "accept"
"(progn
(setq folder_path (get_tile \"folder_path\"))
(setq x_space (distof (get_tile \"x_space\")))
(setq y_space (distof (get_tile \"y_space\")))
(setq col_count (atoi (get_tile \"col_count\")))
(if (or (not folder_path) (= folder_path \"\"))
(alert \"请选择一个文件夹！\")
(if (or (not x_space) (not y_space) (<= col_count 0))
(alert \"无效的间隔或每行数量设置！\")
(done_dialog 1) ; 值为1表示成功
)
)
)"
)
;; --- 3. 启动对话框并获取用户输入 ---
(if (= (start_dialog) 1)
(progn
;; --- 4. 准备工作 ---
(setq old_cmdecho (getvar "CMDECHO"))
(setq old_filedia (getvar "FILEDIA"))
(setvar "CMDECHO" 0)
(setvar "FILEDIA" 0)
(princ "\n正在准备合并图纸...")
;; 检查文件夹路径最后是否有斜杠
(if (/= (substr folder_path (strlen folder_path)) "\\")
(setq folder_path (strcat folder_path "\\"))
)
;; 获取文件夹内所有DWG文件
(setq dwg_files (vl-directory-files folder_path "*.dwg" 1))
(if (not dwg_files)
(alert (strcat "在文件夹 " folder_path " 中未找到任何DWG文件！"))
(progn
;; --- 5. 开始循环合并 ---
(setq ins_pt (list 0.0 0.0 0.0)) ; 初始插入点
(setq current_col 0) ; 当前列数
(setq current_y 0.0) ; 当前行的Y坐标
(setq max_row_height 0.0) ; 当前行的最大高度
(foreach dwg_name dwg_files
(setq full_path (strcat folder_path dwg_name))
(setq xref_name (vl-filename-base dwg_name)) ; 使用文件名作为外部参照名
(princ (strcat "\n正在处理: " dwg_name))
;; 使用XREF-BIND方法来避免块名冲突
;; 1. 附加外部参照 (Attach Xref)
(command "_.XREF" "_A" full_path "0,0,0" "" "" "")
;; 2. 绑定外部参照 (Bind Xref) - 'Bind'类型会自动重命名冲突对象
(command "_.XREF" "_B" xref_name)
;; 3. 绑定后会生成一个块参照，获取它的信息
(setq last_ent (entlast))
(if last_ent
(progn
(setq obj (vlax-ename->vla-object last_ent))
(vla-getboundingbox obj 'min_pt 'max_pt)
(setq min_pt (vlax-safearray->list min_pt))
(setq max_pt (vlax-safearray->list max_pt))
;; 计算包围盒的宽度和高度
(setq width (- (car max_pt) (car min_pt)))
(setq height (- (cadr max_pt) (cadr min_pt)))
;; 4. 移动块参照到计算好的位置
(command "_.MOVE" last_ent "" "0,0,0" ins_pt)
;; 5. （可选）分解块参照，使其变为普通实体
(command "_.EXPLODE" last_ent)
;; 6. 更新下一个插入点的位置
;; 更新当前行的最大高度
(if (> height max_row_height)
(setq max_row_height height)
)
;; 增加列计数器
(setq current_col (1+ current_col))
;; 检查是否需要换行
(if (>= current_col col_count)
(progn
;; 换行
(setq current_col 0) ; 重置列计数
(setq current_y (- current_y max_row_height y_space)) ; 计算新行的Y坐标
(setq max_row_height 0.0) ; 重置行高
(setq ins_pt (list 0.0 current_y 0.0)) ; 设置新行的第一个插入点
)
(progn
;; 不换行，更新同一行中的下一个插入点
(setq ins_pt (list (+ (car ins_pt) width x_space) (cadr ins_pt) 0.0))
)
)
)
(princ (strcat " ... 无法处理 " dwg_name))
)
)
(princ "\n所有图纸合并完成！")
)
)
;; --- 6. 恢复系统变量 ---
(setvar "CMDECHO" old_cmdecho)
(setvar "FILEDIA" old_filedia)
(princ)
)
(princ "\n*已取消*")
)
(princ)
)
;;; 辅助函数: 弹出Windows文件夹选择对话框
(defun get_folder (/ shell folder folder_path)
(vl-load-com)
(if (setq shell (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(progn
(setq folder (vlax-invoke-method shell 'BrowseForFolder 0 "请选择包含DWG图纸的文件夹" 0))
(vlax-release-object shell)
(if folder
(progn
(setq folder_path (vlax-get-property folder 'Self))
(setq folder_path (vlax-get-property folder_path 'Path))
(vlax-release-object folder)
)
)
)
)
folder_path
)
(princ "\nMergeDWGs.lsp 已加载。输入 MERGEDWGS 启动程序。")
(princ)
// DCL file for DWG Merge Utility
// Save as MergeDWGs.dcl
MergeDWGsDialog : dialog {
label = "批量合并DWG图纸";
: column {
: boxed_row {
label = "源文件夹";
: edit_box { key = "folder_path"; width = 45; }
: button { key = "browse"; label = "浏览..."; fixed_width = true; }
}
: boxed_column {
label = "布局设置";
: row {
: edit_box { key = "x_space"; label = "横向间隔 (X):"; value = "1000"; edit_width = 8; }
: edit_box { key = "y_space"; label = "纵向间隔 (Y):"; value = "1000"; edit_width = 8; }
}
: edit_box { key = "col_count"; label = "每行图纸数量:"; value = "5"; edit_width = 8; }
}
}
ok_cancel;
}
不错！！！不错！！！不错！！！
DCL和LSP源码文件在此，程序非常好用，但有几个小问题：
1、程序在每打开的一幅图中只能用一次，再次用就出错，经反馈修改几次一直没能改正，后因没充费也就没法再修改了，这程序不是我用的只是爱好试试AI，半年收费80元哈。
2、程序用过后，保存图时被改为不能调用对话框选择路径，感觉是改了那个系统变量。
3、程序结束后要有个运行时间就好了。
以下是AI给出的解决方案，但没试成功
解决方案：
总是卸载对话框：在 (start_dialog) 执行完毕后，无论用户是点击了确定还是取消，都必须立即调用 (unload_dialog dcl_id) 来释放对话框资源。在我的代码中，这一行 (unload_dialog dcl_id) 放在 (start_dialog) 的正下方，确保它一定会被执行。
使用局部变量：在函数定义时使用 (defun c:MDWG (/ var1 var2 ...)) 的方式声明所有变量为局部变量。这样可以防止变量（尤其是 dcl_id）污染全局环境，避免不同次运行之间互相干扰。
完善的错误处理：通过定义局部的 *error* 函数，可以确保即使用户按 ESC 键或程序在执行过程中发生其他错误，(unload_dialog dcl_id) 也能被调用，从而保证程序的健壮性。
以下是AI给出的程序使用说明：
如何使用
保存文件：将上述两段代码分别保存为 MergeDWGs.dcl 和 MergeDWGs.lsp，并确保它们在同一个文件夹里。
加载程序：
打开AutoCAD。
在命令行输入 APPLOAD 命令。
在弹出的对话框中，找到并选择 MergeDWGs.lsp 文件，然后点击“加载”。
或者，您可以直接将 MergeDWGs.lsp 文件拖拽到AutoCAD的绘图窗口中。
运行程序：
在命令行输入 MERGEDWGS 并按回车。
操作对话框：
程序会弹出一个名为“批量合并DWG图纸”的对话框。
点击 “浏览...” 按钮，选择您存放DWG图纸的文件夹。
在 “横向间隔 (X)” 和 “纵向间隔 (Y)” 输入框中设置图与图之间的距离。
在 “每行图纸数量” 中设置一行排列几个图。
点击 “确定”。
等待完成：
程序将开始自动处理，您可以在命令行看到处理进度。
处理完成后，所有图纸将按照您设置的布局排列在当前图形空间中，并且内部的块名都已自动重命名，不会发生冲突。
注意事项
程序会将所有图纸合并到当前打开的这个DWG文件中。建议在一个新建的空白文件中运行此程序。
图纸数量越多，处理时间越长，请耐心等待。
程序最后会分解（Explode）插入的图块，使它们成为独立的实体。如果您希望保留它们为独立的块（块名为原文件名），可以注释掉 (command "_.EXPLODE" last_ent) 这一行代码。
默认的间隔单位与您当前图形的单位一致。如果您的图纸单位是毫米，那么1000就代表1000毫米。
内容由AI生成、真假自行辨别！
xiaotao 发表于 2025-10-31 20:52
用哪个AI写的？
claude
这是个收费的AI，当然比国产免费的应好的多吧 就是用的这个AI
如有老师能再将程序完善一下就好了
谢谢
感谢大神分享
ynhh 发表于 2025-10-31 21:03
claude
这是个收费的AI，当然比国产免费的应好的多吧
写lisp这种非热门代码、体验最好的是qwen