复制文件相关函数（搬运非原创）

CAD智能@未来

;功能： 复制文件或目录
(Defun vldos-copy (from to / sys folder)
  (setq        from (vldos-formatpath from)
        to   (vldos-formatpath to)
  )
  (if (null (vl-file-directory-p to))
    (setq to (vldos-mkdir to))
  )
  (if (setq sys (vlax-get-or-create-object "Shell.Application"))
    (progn
      (if (setq folder (vlax-invoke-method sys 'namespace to))
        (progn
          (vlax-invoke-method folder 'copyhere from (+ 4 16))
          (vlax-release-object folder)
        )
      )
      (vlax-release-object sys)
    )
  )
  (princ)
)
;功能：复制目录下所有文件和目录
(Defun vldos-copy2 (From to / rtn)
  (cond
    ((vl-file-directory-p From)
     (if (< (strlen to) 3)
       (setq to (strcat to "\\"))
       (if (not (vl-file-directory-p to))
         (vldos-mkdir to)
       )
     )
     (if (setq
           Rtn (vlax-get-or-create-object "Scripting.FileSystemObject")
         )
       (progn
         (vlax-invoke-method Rtn 'CopyFolder From to T)
         (vlax-release-object Rtn)
         (if (vl-file-directory-p to)
           (setq Rtn (vldos-formatpath to))
         )
       )
     )
    )
    ((findfile From)
     (vl-file-copy From to)
     (if (setq rtn (findfile to))
       (setq rtn (vldos-formatpath rtn))
     )
    )
  )
  rtn
)
;功能：自动创建参数中所有不存在的目录
(Defun vldos-MkDir (Folder / FolderX Fil FFF Pos DIR DRV)
  (if (null
        (setq
          Fil (vlax-get-or-create-object "Scripting.FileSystemObject")
        )
      )
    (setq Folder nil)
    (progn
      (while (vl-string-search "/" Folder)
        (setq Folder (vl-string-subst "\\" "/" Folder))
      )
      (if (wcmatch Folder "*\\")
        (setq Folder (substr Folder 1 (1- (strlen Folder))))
      )
      (setq FolderX Folder)
      (while (setq Pos (vl-string-search "\\" Folder))
        (setq FFF    (cons (substr Folder 1 Pos) FFF)
              Folder (substr Folder (+ Pos 2))
        )
      )
      (setq FFF        (reverse (cons Folder FFF))
            DRV        (car FFF)
            FFF        (cdr FFF)
      )
      (foreach DIR FFF
        (if
          (null        (vl-file-directory-p (setq DRV (strcat DRV "\\" DIR)))
          )
           (vlax-invoke-method
             Fil
             'createfolder
             DRV
           )
        )
      )
      (vlax-release-object Fil)
      (if (setq Folder (vl-file-directory-p FolderX))
        (setq Folder (vldos-formatpath FolderX))
      )
    )
  )
  Folder
)
;功能：转换路径中字符 "/" 为 "\\" 并返回大写值
(Defun vldos-formatpath        (string)
  (while (vl-string-search "/" string)
    (setq string (vl-string-subst "\\" "/" string))
  )
  (while (vl-string-search "\\\\" string)
    (setq string (vl-string-subst "\\" "\\\\" string))
  )
  (setq string (strcase string))
  string
)

zark

用DOS来会不会更快？

w379106181

感谢大神分享