[编程交流] 创建目录Visual Lisp

 
(if (not (vl-file-directory-p "U:\\Project1\\CAD_Xref_Files\"))
(vl-mkdir "U:\\Project1\\CAD_Xref_Files\"))

;;-------------------=={ Make Directory }==-------------------;;
;;                                                            ;;
;;  Creates a directory structure                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  dir - the directory to create                             ;;
;;------------------------------------------------------------;;
;;  Returns:  T if directory creation is successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:MakeDirectory ( dir / MakeDirectory folders )
 ;; © Lee Mac 2010
 ;; (LM:MakeDirectory "C:\\Folder\\Subfolder")
 (vl-load-com)
 (defun MakeDirectory ( root folders )
   (if folders
     (
       (lambda ( dir ) (vl-mkdir dir)
         (MakeDirectory dir (cdr folders))
       )
       (strcat root "\" (car folders))
     )
   )
 )
 
 (if (setq folders (LM:str->lst (vl-string-translate "/" "\" dir) "\"))
   (MakeDirectory (car folders) (cdr folders))
 )
 (vl-file-directory-p dir)
)
;;-------------------=={ String -> List }==-------------------;;
;;                                                            ;;
;;  Separates a string into a list of strings using a         ;;
;;  specified delimiter string                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - string to process                                   ;;
;;  del - delimiter by which to separate the string           ;;
;;------------------------------------------------------------;;
;;  Returns:  A list of strings                               ;;
;;------------------------------------------------------------;;
(defun LM:str->lst ( str del / pos )
 ;; © Lee Mac 2010
 (if (setq pos (vl-string-search del str))
   (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
   (list str)
 )
)

;;; STR2LST
;;; Transforms a string with separator into a list of strings
;;; Author: Gile
;;; Arguments
;;; str = the string
;;; sep = the separator pattern
(defun  str2lst(str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
     (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
) 
(setq MyPath "U:\\Project1\\CAD_Xref_Files"
     MyPath (str2lst MyPath "\")
     thePath (car MyPath))
(foreach PathItem (cdr MyPath)
(if (not (vl-file-directory-p (setq thePath (strcat thePath "\" PathItem))))
 (vl-mkdir thePath)
)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
 ;; © Lee Mac 2010
 (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
       HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
       Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND)  msg flag dir))
 (vlax-release-object Shell)
 
 (if Fold
   (progn
     (setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
     (vlax-release-object Self)
     (vlax-release-object Fold)      
     
     (and (= "\" (substr Path (strlen Path)))
          (setq Path (substr Path 1 (1- (strlen Path)))))
   )
 )
 Path
)

(LM:DirectoryDialog "Select Directory" nil 0)