保证路径所在文件夹存在

自贡黄明儒

为了将我的.mun文件拷贝到指定文件夹下面，我写了如下程序，用点用处，但作用不太

1. ;;(vlax-invoke-method (vlax-create-object "Scripting.FileSystemObject") "GetFolder" (getenv "public"))
   
2. ;;返回存在的文件夹路径
   
3. (defun DIRECTORY-P (str / A FLAG L STR1);(setq str (strcat (getenv "public") "/b/"))
   
4.   (setq str1 (fnsplitl str))
   
5.   (cond        ((and str1 (/= (last str1) ""))
   
6.          (setq str (vl-string-right-trim "/\\" (car str1)))
   
7.         )                                ;(setq str "C:\\Users\\Public\\b/1.txt")
   
8.         ((= (last str1) "") (setq str str))
   
9.         ;;(setq str "C:\\Users\\Public\\b")
   
10.         (T (setq str (vl-string-right-trim "/\\" str)))
    
11.                                         ;(setq str "C:\\Users\\Public\\b\\")
    
12.   )
    
13.   (if (VL-FILE-DIRECTORY-P str)
    
14.     str
    
15.     (progn
    
16.       (setq L (parse4 str "/\\"))
    
17.       (setq str1 (car L))
    
18.       (setq L (cdr L))
    
19.       (while (and (setq a (car L))
    
20.                   (not Flag)
    
21.              )
    
22.         (setq L (cdr L))
    
23.         (if (VL-FILE-DIRECTORY-P (strcat str1 "\\" a))
    
24.           (setq str1 (strcat str1 "\\" a))
    
25.           (setq Flag T)
    
26.         )
    
27.       )
    
28.       str1
    
29.     )
    
30.   )
    
31. )
    
32. ;;(DIRECTORY-P (strcat (getenv "public") "/b/d.txt"))
    
33. ;;(DIRECTORY-P (strcat "D:/" "块包围盒.lsp"))
    
34. ;;(DIRECTORY-P (strcat (getenv "public") "/b"))
    
35. 
    
36. ;;返回存在的文件夹路径,如果文件夹不存在，则创建
    
37. ;;如果str是文件全路径，则保证路径所在文件夹存在
    
38. ;;例如(VL-FILE-COPY "D:\\1.txt" "C:\\Users\\Public\\b/c/.txt"),如果没有文件夹b 和c 则创建;
    
39. ;;以确保拷贝成功
    
40. (defun DIRECTORYMake-P (str / A L STR1)
    
41.   (setq str1 (fnsplitl str))
    
42.   (cond        ((and str1 (/= (last str1) ""))
    
43.          (setq str (vl-string-right-trim "/\\" (car str1)))
    
44.         )                                ;(setq str "C:\\Users\\Public\\b/1.txt")
    
45.         ((= (last str1) "") (setq str str))
    
46.         ;;(setq str "C:\\Users\\Public\\b")
    
47.         (T (setq str (vl-string-right-trim "/\\" str)))
    
48.                                         ;(setq str "C:\\Users\\Public\\b\\")
    
49.   )
    
50.   (if (VL-FILE-DIRECTORY-P str)
    
51.     str
    
52.     (progn
    
53.       (setq L (parse4 str "/\\"))
    
54.       (setq str1 (car L))
    
55.       (setq L (cdr L))
    
56.       (while (setq a (car L))
    
57.         (setq L (cdr L))
    
58.         (setq str1 (strcat str1 "\\" a))
    
59.         (if (not (VL-FILE-DIRECTORY-P str1))
    
60.           (vl-mkdir str1)
    
61.         )
    
62.       )
    
63.       str1
    
64.     )
    
65.   )
    
66. )
    
67. ;;(DIRECTORYMake-P "C:\\Users\\Public\\b/c")

;;(vlax-invoke-method (vlax-create-object "Scripting.FileSystemObject") "GetFolder" (getenv "public"))<br /> ;;返回存在的文件夹路径<br /> (defun DIRECTORY-P (str / A FLAG L STR1);(setq str (strcat (getenv "public") "/b/"))<br />   (setq str1 (fnsplitl str))<br />   (cond        ((and str1 (/= (last str1) ""))<br />          (setq str (vl-string-right-trim "/\\" (car str1)))<br />         )                                ;(setq str "C:\\Users\\Public\\b/1.txt")<br />         ((= (last str1) "") (setq str str))<br />         ;;(setq str "C:\\Users\\Public\\b")<br />         (T (setq str (vl-string-right-trim "/\\" str)))<br />                                         ;(setq str "C:\\Users\\Public\\b\\")<br />   )<br />   (if (VL-FILE-DIRECTORY-P str)<br />     str<br />     (progn<br />       (setq L (parse4 str "/\\"))<br />       (setq str1 (car L))<br />       (setq L (cdr L))<br />       (while (and (setq a (car L))<br />                   (not Flag)<br />              )<br />         (setq L (cdr L))<br />         (if (VL-FILE-DIRECTORY-P (strcat str1 "\\" a))<br />           (setq str1 (strcat str1 "\\" a))<br />           (setq Flag T)<br />         )<br />       )<br />       str1<br />     )<br />   )<br /> )<br /> ;;(DIRECTORY-P (strcat (getenv "public") "/b/d.txt"))<br /> ;;(DIRECTORY-P (strcat "D:/" "块包围盒.lsp"))<br /> ;;(DIRECTORY-P (strcat (getenv "public") "/b"))<br /> <br /> ;;返回存在的文件夹路径,如果文件夹不存在，则创建<br /> ;;如果str是文件全路径，则保证路径所在文件夹存在<br /> ;;例如(VL-FILE-COPY "D:\\1.txt" "C:\\Users\\Public\\b/c/.txt"),如果没有文件夹b 和c 则创建;<br /> ;;以确保拷贝成功<br /> (defun DIRECTORYMake-P (str / A L STR1)<br />   (setq str1 (fnsplitl str))<br />   (cond        ((and str1 (/= (last str1) ""))<br />          (setq str (vl-string-right-trim "/\\" (car str1)))<br />         )                                ;(setq str "C:\\Users\\Public\\b/1.txt")<br />         ((= (last str1) "") (setq str str))<br />         ;;(setq str "C:\\Users\\Public\\b")<br />         (T (setq str (vl-string-right-trim "/\\" str)))<br />                                         ;(setq str "C:\\Users\\Public\\b\\")<br />   )<br />   (if (VL-FILE-DIRECTORY-P str)<br />     str<br />     (progn<br />       (setq L (parse4 str "/\\"))<br />       (setq str1 (car L))<br />       (setq L (cdr L))<br />       (while (setq a (car L))<br />         (setq L (cdr L))<br />         (setq str1 (strcat str1 "\\" a))<br />         (if (not (VL-FILE-DIRECTORY-P str1))<br />           (vl-mkdir str1)<br />         )<br />       )<br />       str1<br />     )<br />   )<br /> )<br /> ;;(DIRECTORYMake-P "C:\\Users\\Public\\b/c")

ymcui

好源码下载学习,谢谢

czb203

向黄大师学习

muai2010

支持黄大师

kozmosovia

没必要那么麻烦，直接(vl-catch-all-apply 'vl-mkdir (list dir))

ghgh0130

支持黄大师

LYC688

(defun c:usb ()   (vl-load-com)   (setq fldr "D:\\123")   (setq selection (ssget "WP" '(0. "INSERT") (cons 2 "*.dwg")))   (if (null selection)     (princ "\n未选择到任何文件。")     (progn       (setq acadObj (vlax-get-acad-object))       (setq drives (vlax-invoke-method acadObj 'GetInterfaceObject "AutoCAD.Application.19"))       (setq usbDrive nil)       (foreach drive drives         (if (vlax-get-property drive 'DriveType)             (if (= (vlax-get-property drive 'DriveType) 2)                 (setq usbDrive drive)             )         )       )       (if usbDrive           (progn             (repeat (sslength selection)               (setq ent (ssname selection (setq i (1+ i))))               (setq block-ref (vlax-ename->vla-object ent))               (setq file-path (vla-get-pathname block-ref))               (vl-file-copy file-path (strcat (vlax-get-property usbDrive 'RootDirectory) "\\123\\" (vl-filename-base file-path) ".dwg"))             )             (princ "\n文件复制成功到 U 盘。")           )           (princ "\n未找到 U 盘。")       )     )   )   (princ) )