求开发一个批量合并dwg 格式文件 和批量拆分dwg 插件

xinhaichun

可尝试其中的“图纸拆合”功能
http://bbs.mjtd.com/thread-181535-1-1.html

cjf160204

(defun c:DWGTools (/)
  ;; 主功能选择菜单
  (initget "Insert Split")
  (setq choice (getkword "\n选择功能 [插入(I)/拆分(S)]: <I> "))
  (if (not choice) (setq choice "Insert"))

  (cond
    ((= choice "Insert") (c:BatchInsert))
    ((= choice "Split") (c:BatchSplit))
  )
  (princ)
)

(defun c:BatchInsert (/ pf path aa n i nn pp)
  ;; 批量插入功能 - 仅支持块插入
  (setvar "CMDECHO" 0)
  (setq pf (getfiled "选择要插入的DWG文件" "" "dwg" 8))
  (if (not pf) (progn (princ "\n未选择文件。") (exit)))

  (setq path (vl-filename-directory pf))
  (setq path (strcat path "\\"))
  (setq aa (vl-directory-files path "*.dwg" 1))
  (setq n (length aa))
  (setq i 0 nn 0)

  (prompt "\n正在按块插入图幅，请稍候...\n")

  (while (< i n)
    (setq pp (nth i aa))
    (setq fullpath (strcat path pp))
    (command "insert" fullpath "0,0" "1" "1" "0")
    (setq nn (1+ nn))
    (princ (strcat "第" (itoa nn) "个图块: " pp " \r"))
    (setq i (1+ i))
  )

  (command "zoom" "e" "zoom" "0.8x")
  (setvar "CMDECHO" 1)
  (princ (strcat "\n操作完成，共处理了 " (itoa nn) " 个文件。"))
  (princ)
)

(defun c:BatchSplit (/ winshell *avzzts-reg-root* *avzzts-reg-key* path folder root filename name ss ss1 i desktopPath)
  ;; 批量拆分功能 - 改进版本，默认保存到桌面
  (princ "-->图纸拆分导出")
  (setvar "cmdecho" 0)

  ;; 获取桌面路径
  (setq desktopPath (strcat (getenv "USERPROFILE") "\\Desktop\\"))

  (setq winshell (vlax-create-object "Shell.Application"))
  (setq *avzzts-reg-root* "HKEY_CURRENT_USER\\Software\\Autodesk\\avzztls")
  (setq *avzzts-reg-key* (strcat *avzzts-reg-root* "\\R" (vl-princ-to-string (atof (getvar "acadver")))))
  (setq path (vl-registry-read *avzzts-reg-key* "dwgsplitpath"))

  ;; 如果注册表中没有路径或路径无效，使用桌面路径
  (if (or (null path) (null (findfile path)))
    (progn
      (setq folder (strcat "分图_" (menucmd "M=$(edtime,$(getvar,date),YYYY-MM-DD)")))
      (setq path (strcat desktopPath folder))
      ;; 创建文件夹（如果不存在）
      (if (not (vl-file-directory-p path))
        (vl-mkdir path)
      )
    )
  )

  (setq path (strcat path "\\"))
  (setq filename (getfiled "请输入文件名" path "dwg" 1))

  ;; 如果用户取消了文件选择，退出函数
  (if (not filename)
    (progn
      (princ "\n操作已取消。")
      (setvar "cmdecho" 1)
      (return)
    )
  )

  (setq name (vl-filename-base filename))
  (setq path (vl-string-right-trim "\\" (vl-filename-directory filename)))
  (vl-registry-write *avzzts-reg-key* "dwgsplitpath" path)
  (setq path (strcat path "\\"))

  (princ "\n请选择需要分图的内容:")
  (setq i 0)
  (setq ss1 nil)
  (while (setq ss (ssget))
    (vl-cmdf "wblock"
             (strcat path name
                     "_" (menucmd "M=$(edtime,$(getvar,date),HH-MM-SS)")
                     "_" (itoa (setq i (1+ i)))
                     ".dwg")
             "" "0,0" ss "")
    (vl-cmdf "oops")
    (princ (strcat "\n已保存: " path name "_" (menucmd "M=$(edtime,$(getvar,date),HH-MM-SS)") "_" (itoa i) ".dwg"))
    (princ "\n请继续选择<右键结束>:")
    (setq ss1 ss)
  )

  (if ss1
    (progn
      (vlax-invoke-method winshell 'open path)
      (princ (strcat "\n所有文件已保存到: " path))
    )
  )

  (setvar "cmdecho" 1)
  (princ)
)

;; 提供独立命令别名
(defun c:BI () (c:BatchInsert))
(defun c:BS () (c:BatchSplit))

(princ "\nDWG工具已加载，命令: DWGTools (或 BI/BS 直接调用功能)")
(princ)

xiangtu

cjf160204 发表于 2025-9-1 19:36
(defun c:DWGTools (/)
  ;; 主功能选择菜单
  (initget "Insert Split")

有程序吗  发我测试下  可以不

cjf160204

你看看嘛…………