图纸批量合并插件（测试可用）

1836794553@qq.c

;; 图纸合并主函数 - 优化版本
(defun c:MERGE_DRAWINGS (/ spacing file_list base_pt)
  (vl-load-com)
  (setq old_error *error*)

  (princ "\n*** 图纸合并插件 ***")

  (if (and (setq file_list (select_multiple_dwg_files))
           (setq spacing (get_spacing))
           (setq base_pt (getpoint "\n请选择插入基准点: "))
      )
    (progn
      (princ (strcat "\n已选择 " (itoa (length file_list)) " 个文件"))
      (process_files_with_blocks file_list base_pt spacing "文件")
    )
    (princ "\n取消操作。")
  )
  (princ)
)

;; 文件夹批量合并 - 优化版本
(defun c:MERGE_FOLDER (/ folder_path file_list spacing base_pt)
  (vl-load-com)

  (princ "\n*** 文件夹批量合并 ***")

  (if (and (setq folder_path (browse_for_folder "选择包含DWG文件的文件夹"))
           (vl-file-directory-p folder_path)
           (setq file_list (get_sorted_dwg_files folder_path))
           (setq spacing (get_spacing))
           (setq base_pt (getpoint "\n请选择插入基准点: "))
      )
    (progn
      (princ (strcat "\n找到 " (itoa (length file_list)) " 个DWG文件"))
      (process_files_with_blocks file_list base_pt spacing "文件夹")
    )
    (princ "\n取消操作或文件夹无效。")
  )
  (princ)
)

;; 核心处理函数 - 合并文件处理流程
(defun process_files_with_blocks (file_list base_pt spacing mode / temp_dir processed_files)
  (princ "\n分析并重命名同名块...")

  (if (setq temp_dir (create_temp_directory))
    (progn
      (setq processed_files (preprocess_blocks_before_insert file_list temp_dir))

      (if processed_files
        (progn
          (princ (strcat "\n预处理完成，开始合并" mode "..."))
          (merge_drawing_list processed_files base_pt spacing)
          (cleanup_temp_files processed_files temp_dir)
          (princ (strcat "\n" mode "合并完成！"))
        )
        (princ "\n预处理失败。")
      )
    )
    (princ "\n临时目录创建失败。")
  )
)

;; 合并图纸列表的核心函数
(defun merge_drawing_list (file_list base_pt spacing / current_x current_y file_count)
  (setq current_x (car base_pt)
        current_y (cadr base_pt)
        file_count 0
        *base_pt* base_pt
  )

  (foreach file_path file_list
    (if (findfile file_path)
      (progn
        (setq file_count (1+ file_count))
        (princ (strcat "\n正在处理 " (itoa file_count) "/" (itoa (length file_list)) ": " (vl-filename-base file_path)))

        (if (setq result (insert_drawing_simple file_path current_x current_y spacing))
          (setq current_x (car result)
                current_y (cadr result)
          )
          (princ " [插入失败]")
        )
      )
      (princ (strcat "\n文件未找到: " file_path))
    )
  )

  (princ (strcat "\n共处理 " (itoa file_count) " 个文件。"))
)

;; 预处理块重命名 - 优化版本
(defun preprocess_blocks_before_insert (file_list temp_dir / all_blocks block_count mapping processed_files)
  (setq all_blocks '()
        block_count '()
        mapping '()
        processed_files '()
  )

  ;; 收集块定义信息
  (setq file_index 0)
  (foreach file_path file_list
    (setq file_index (1+ file_index))
    (foreach block_name (get_file_block_definitions_safe file_path)
      (setq all_blocks (cons (cons block_name file_path) all_blocks))
      (if (setq count_entry (assoc block_name block_count))
        (setq block_count (subst (cons block_name (1+ (cdr count_entry))) count_entry block_count))
        (setq block_count (cons (cons block_name 1) block_count))
      )
    )
  )

  ;; 创建重命名映射
  (foreach block_entry block_count
    (if (> (cdr block_entry) 1)
      (progn
        (princ (strcat "\n发现重复块: " (car block_entry)))
        (setq file_counter 1)
        (foreach file_path file_list
          (if (member (cons (car block_entry) file_path) all_blocks)
            (progn
              (if (> file_counter 1)
                (setq mapping (cons (list file_path (car block_entry) (strcat (car block_entry) "_" (itoa file_counter))) mapping))
              )
              (setq file_counter (1+ file_counter))
            )
          )
        )
      )
    )
  )

  ;; 应用重命名
  (setq file_index 0)
  (foreach file_path file_list
    (setq file_index (1+ file_index))
    (if (setq temp_file (create_renamed_file file_path mapping temp_dir file_index))
      (setq processed_files (cons temp_file processed_files))
    )
  )

  (reverse processed_files)
)

;; 创建重命名后的临时文件 - 优化版本
(defun create_renamed_file (file_path mapping temp_dir file_index / temp_file doc renamed_count)
  (setq temp_file (strcat temp_dir "\\" (vl-filename-base file_path) "_processed.dwg")
        renamed_count 0
  )

  (if (and (findfile file_path)
           (vl-file-copy file_path temp_file)
           (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) temp_file))
      )
    (progn
      (foreach map_entry mapping
        (if (and (equal (car map_entry) file_path)
                 (rename_block_in_document doc (cadr map_entry) (caddr map_entry))
            )
          (setq renamed_count (1+ renamed_count))
        )
      )
      (vla-save doc)
      (vla-close doc)
      (if (> renamed_count 0) (princ (strcat " [重命名 " (itoa renamed_count) " 个块]")))
      temp_file
    )
    nil
  )
)

;; 在文档中重命名块
(defun rename_block_in_document (doc old_name new_name / blocks found)
  (setq blocks (vla-get-blocks doc)
        found nil
  )
  (vlax-for block blocks
    (if (= (vla-get-name block) old_name)
      (progn
        (vla-put-name block new_name)
        (setq found T)
      )
    )
  )
  found
)

;; 安全获取文件块定义 - 优化版本
(defun get_file_block_definitions_safe (file_path / doc blocks block_list)
  (setq block_list '())
  (if (and (findfile file_path)
           (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) file_path))
      )
    (progn
      (setq blocks (vla-get-blocks doc))
      (vlax-for block blocks
        (setq block_name (vla-get-name block))
        (if (and (not (wcmatch block_name "*`*,`**,*_SPACE"))
                 (not (member block_name '("MODEL_SPACE" "PAPER_SPACE" "Model_Space" "Paper_Space")))
            )
          (setq block_list (cons block_name block_list))
        )
      )
      (vla-close doc)
    )
  )
  block_list
)

;; 获取排序的DWG文件列表
(defun get_sorted_dwg_files (folder_path)
  (if (setq all_files (vl-directory-files folder_path "*.dwg" 1))
    (vl-sort (mapcar '(lambda (x) (strcat folder_path "\\" x)) all_files)
             '(lambda (a b) (< (strcase a) (strcase b)))
    )
  )
)

;; 简化插入图纸函数 - 优化版本
(defun insert_drawing_simple (file_path current_x current_y spacing / insertion_pt new_x new_y)
  (setq insertion_pt (list current_x current_y 0.0))
  (setq old_cmd (getvar "CMDECHO"))

  (setvar "CMDECHO" 0)
  (command "_.-INSERT" file_path insertion_pt "1" "1" "0")
  (while (> (getvar "CMDACTIVE") 0) (command ""))
  (setvar "CMDECHO" old_cmd)

  ;; 更新位置
  (setq new_x (+ current_x 1000 spacing)
        new_y current_y
  )
  (if (> new_x (+ (car *base_pt*) 4000))
    (setq new_x (car *base_pt*)
          new_y (- current_y 800 spacing)
    )
  )
  (list new_x new_y)
)

;; 清理临时文件
(defun cleanup_temp_files (processed_files temp_dir)
  (foreach temp_file processed_files
    (if (findfile temp_file) (vl-file-delete temp_file))
  )
  (if (vl-file-directory-p temp_dir) (vl-file-delete temp_dir))
)

;; 创建临时目录
(defun create_temp_directory ()
  (setq temp_path (strcat (getenv "TEMP") "\\cad_merge_" (rtos (getvar "CDATE") 2 6)))
  (if (not (vl-file-directory-p temp_path)) (vl-mkdir temp_path))
  temp_path
)

;; 弹窗选择文件夹
(defun browse_for_folder (msg / shell folder folderobj result)
  (vl-load-com)
  (if (and (setq shell (vlax-create-object "Shell.Application"))
           (setq folder (vlax-invoke-method shell 'BrowseForFolder 0 msg 0))
           (setq folderobj (vlax-get-property folder 'Self))
      )
    (progn
      (setq result (vlax-get-property folderobj 'Path))
      (mapcar 'vlax-release-object (list folderobj folder shell))
      result
    )
    (getstring T (strcat msg ": "))
  )
)

;; 获取合并间距
(defun get_spacing ()
  (initget 6)
  (if (setq input (getreal "\n请输入图纸合并间距 <100.0>: "))
    input
    100.0
  )
)

;; 选择多个DWG文件
(defun select_multiple_dwg_files (/ files file_dialog)
  (setq files '())
  (if (setq file_dialog (getfiled "选择DWG文件" "" "dwg" 16))
    (progn
      (if (= (type file_dialog) 'LIST)
        (setq files file_dialog)
        (progn
          (setq files (cons file_dialog files))
          (while (setq next_file (getfiled "继续选择文件 (取消结束)" "" "dwg" 0))
            (setq files (cons next_file files))
          )
          (reverse files)
        )
      )
    )
  )
)

;; 错误处理函数
(defun error_handler (msg)
  (princ (strcat "\n错误: " msg))
  (setvar "CMDECHO" 1)
  (setq *error* old_error)
  (princ)
)

;; 设置错误处理
(setq old_error *error*)
(setq *error* error_handler)

(princ "\n图纸合并插件已加载。")
(princ "\n命令: MERGE_DRAWINGS, MERGE_FOLDER")
(princ)

1836794553@qq.c

麻烦各位大神帮忙优化

1836794553@qq.c

1836794553@qq.c 发表于 2025-10-25 12:43
麻烦各位大神帮忙优化

插件已实现了同名块修改的功能

qifeifei

期待被优化

qwsss31

好用吗？大佬

ynhh

谢谢，虽然慢
但还是全部并出来了，感觉是各个图被打成整块了
但细看图形错位了，支持再优化

ynhh

有的图出错也不是每次都错
后来试又不错了
只是太慢
还是就是插入的间距与输入的不对，输入100的成了506
建议补上合并时间就好了
这里提供一些图供您测试
谢谢

e2002

我不太理解，是什么原因需要这样操作？目的是什么？任意一个建筑设计项目的一整套施工图，都包含有各个专业，各专业自己也是一系列的dwg文件构成，大家时常都抱怨AutoCAD打开文件太耗时，这样整合大量dwg到一个dwg内，那不是打开就更费时了吗？而且现在依然还有大量企业的归档要求是1张图纸对应1个dwg文件（实际上早就不合理了，这里不讨论），这种整合有什么意义呢？能否说说理由？

蓝天cayuer

e2002 发表于 2025-10-28 10:55
我不太理解，是什么原因需要这样操作？目的是什么？任意一个建筑设计项目的一整套施工图，都包含有各个专业 ...

  不一定是大图合并
说不定是有些下料图或者是一些示意图合并后，便捷工人查阅。反正我合并图形就是方便自己图纸打印和提供下面等离子识图示意用。
类似于批量打印
一个个打开 太麻烦了。

e2002

蓝天cayuer 发表于 2025-10-28 11:19
不一定是大图合并
说不定是有些下料图或者是一些示意图合并后，便捷工人查阅。反正我合并图形就是方便 ...

理解。

看来这种一般用于一些简单、体量小的文件。

建筑设计行业的图相对复杂、内容多，真要合并，也是全部外部参照处理。否则会卡的动不了...