[LISP函数]：创建目录，包括子目录

apollone

2. (defun string-break (str pat / i j lst)
   
3.   (setq i 0)
   
4.   (while (setq j (vl-string-search pat str i))
   
5.     (setq lst (cons (substr str (1+ i) (- j i)) lst))
   
6.     (setq i (+ j (strlen pat)))
   
7.   )
   
8.   (mapcar (function (lambda (x) (vl-string-trim " " x)))
   
9.           (cons (substr str (1+ i)) lst)
   
10.   )
    
11. )
    
12. 
    
13. (defun string-right-trim (cSet string /)
    
14.   (substr string 1 (vl-string-search cSet string))
    
15. )
    
16. 
    
17. (defun dir-tree        (path / path0 path1 f lst pat)
    
18.   (setq path0 path)
    
19.   (setq path1 path)
    
20.   (setq f nil)
    
21. 
    
22.   ;; break the path
    
23.   (if (setq lst
    
24.              (cond
    
25.                ((vl-string-search (setq pat "\") path)
    
26.                 (string-break path pat)
    
27.                )
    
28.                ((vl-string-search (setq pat "/") path)
    
29.                 (string-break path pat)
    
30.                )
    
31.              )
    
32.       )
    
33.     (progn
    
34. 
    
35.       ;; remove the last element from the list
    
36.       (if (or (vl-string-search ":" (last lst)) (= "" (last lst)))
    
37.         (progn (setq f t)
    
38.                (setq lst (vl-remove (last lst) lst))
    
39.         )
    
40.       )
    
41. 
    
42.       ;; make the tree
    
43.       (setq lst
    
44.              (append
    
45.                (reverse
    
46.                  (mapcar
    
47.                    (function
    
48.                      (lambda (i)
    
49.                        (setq path0 (string-right-trim i path0))
    
50.                      )
    
51.                    )
    
52.                    (mapcar (function (lambda (str) (strcat pat str)))
    
53.                            lst
    
54.                    )
    
55.                  )
    
56.                )
    
57.                (list path1)
    
58.              )
    
59.       )
    
60. 
    
61.       (if f
    
62.         (vl-remove (car lst) lst)
    
63.       )
    
64.     )
    
65.   )
    
66. )
    
67. (defun mk-dir (path /)
    
68.   (vl-every 'vl-mkdir (dir-tree path))
    
69. )
    
70. (princ)
    

(defun string-break (str pat / i j lst)<br />   (setq i 0)<br />   (while (setq j (vl-string-search pat str i))<br />     (setq lst (cons (substr str (1+ i) (- j i)) lst))<br />     (setq i (+ j (strlen pat)))<br />   )<br />   (mapcar (function (lambda (x) (vl-string-trim " " x)))<br />           (cons (substr str (1+ i)) lst)<br />   )<br /> )<br /> <br /> (defun string-right-trim (cSet string /)<br />   (substr string 1 (vl-string-search cSet string))<br /> )<br /> <br /> (defun dir-tree        (path / path0 path1 f lst pat)<br />   (setq path0 path)<br />   (setq path1 path)<br />   (setq f nil)<br /> <br />   ;; break the path<br />   (if (setq lst<br />              (cond<br />                ((vl-string-search (setq pat "\") path)<br />                 (string-break path pat)<br />                )<br />                ((vl-string-search (setq pat "/") path)<br />                 (string-break path pat)<br />                )<br />              )<br />       )<br />     (progn<br /> <br />       ;; remove the last element from the list<br />       (if (or (vl-string-search ":" (last lst)) (= "" (last lst)))<br />         (progn (setq f t)<br />                (setq lst (vl-remove (last lst) lst))<br />         )<br />       )<br /> <br />       ;; make the tree<br />       (setq lst<br />              (append<br />                (reverse<br />                  (mapcar<br />                    (function<br />                      (lambda (i)<br />                        (setq path0 (string-right-trim i path0))<br />                      )<br />                    )<br />                    (mapcar (function (lambda (str) (strcat pat str)))<br />                            lst<br />                    )<br />                  )<br />                )<br />                (list path1)<br />              )<br />       )<br /> <br />       (if f<br />         (vl-remove (car lst) lst)<br />       )<br />     )<br />   )<br /> )<br /> (defun mk-dir (path /)<br />   (vl-every 'vl-mkdir (dir-tree path))<br /> )<br /> (princ)<br />

例如
(mk-dir  "C:\\a\\b\\c\\d\\e")
如已有部分目录存在则不创建

狂刀

如果不在乎闪一下的话：
(command "shell" "md c:\\aaa\\bbb")

如果不想闪的话：
(vl-mkdir "c:\\aaa\\ddd")

wkai

(defun tt(str / re)
  (setq path(zfl-str-parse str "\\") m (car path))
  (foreach n (cdr path)
    (setq m (strcat m "\\" n))
    (vl-mkdir m)
    )
  )

GTJ116600

创建目录，好贴，有机会学习。

jyzas

不错，下来试试怎样:)

you238

vl-mkdir一次只能创建一级目录，
直接用这个(vl-mkdir "c:\\aaa\\ddd")，不能创建
3楼的缺了zfl-str-parse函数

lianghui2018

学习，谢谢楼主分享