CAD 批量插入“dwf”底图 lisp

发表评论

A+

所属分类：CAD

lisp 批量插入“DWF”底图;

(defun c:ssDWF (/ dwf-folder dwfFiles insertionPoint dwfFile)
  ;; 选择文件夹
  (setq dwf-folder (vl-file-syst-get-folder))
  (if dwf-folder
    (progn
      ;; 获取文件夹中所有DWF文件
      (setq dwfFiles (get-dwf-files dwf-folder))

      (if dwfFiles
        (progn
          ;; 获取插入点
          (setq insertionPoint (getpoint "指定插入点: "))
          ;; 遍历并插入每个DWF文件
          (foreach dwfFile dwfFiles
            (command "ATTACH" dwfFile insertionPoint "1" )
          )
          (princ (strcat "\n" (itoa (length dwfFiles)) " 个DWF文件已成功插入."))
        )
        (princ "\n文件夹中没有DWF文件.")  ;; 文件夹中没有DWF文件
      )
    )
    (princ "\n未选择文件夹.")  ;; 未选择文件夹
  )

  (princ)
)
;;=================================
(defun vl-file-syst-get-folder ()
   ;; 选择文件夹并返回路径
  (vl-load-com)
  (setq objShell (vlax-create-object "Shell.Application"))
  (setq objFolder (vlax-invoke-method objShell 'BrowseForFolder 0 "选择文件夹" 0))
  (if objFolder
    (setq folderPath (vlax-get-property objFolder 'Self))
    (setq folderPath nil)
  )
  (if folderPath
    (setq folderPath (vlax-get-property folderPath 'Path))
  )
  folderPath
)
;;======================
(defun get-dwf-files (folderPath)
  ;; 获取文件夹中所有DWF文件的路径
  (setq dwfFiles '())  ;; 初始化文件列表
  (setq dwfFiles (vl-directory-files folderPath "*.dwf" 1))  ;; 获取文件夹中的所有DWF文件
  
  ;; 遍历文件列表并合并文件夹路径
  (setq dwfFilesWithPaths '())  ;; 用于存储完整路径的列表
  (foreach dwf dwfFiles
    (setq dwfFilesWithPaths (append dwfFilesWithPaths (list (strcat folderPath "\\" dwf)))))  ;; 合并路径和文件名

  dwfFilesWithPaths  ;; 返回完整路径列表
)