[编程交流] 目录Lisp

(defun c:BindIt ( / )
(setq vDia (getvar "filedia")
      vEcho (getvar "cmdecho")
      vPrefix (getvar "dwgprefix")
      vName (getvar "dwgname")
      vDate (rtos (getvar "cdate") 2 6)
      vYear (substr vDate 1 4)
      vMonth (substr vDate 5 2)
      vDay (substr vDate 7 2)
      vDateStr (strcat vYear "-" vMonth "-" vDay)
)
(setvar "filedia" 0)
(setvar "cmdecho" 0)
(initget 1 "Bind Email")
(setq vAns (getkword "\nSave file to [Email / Bound] <Bound>: "))
(cond
 ((= "Bind" vAns)
  (setq vDir (strcat vPrefix "Bound"))
 )
 ((= "Email" vAns)
  (setq vDir (strcat vPrefix "Email"))
 )
)
(if (= (vl-file-directory-p vDir) nil)
 (progn
  (vl-mkdir vDir)
  (vl-mkdir (strcat vDir "\" vDateStr))
 )
 (if (= (vl-file-directory-p (strcat vDir "\" vDateStr)) nil)
  (vl-mkdir (strcat vDir "\" vDateStr))
 )
)
(command ".saveas" "" (strcat vDir "\" vDateStr "\" vName))
(setvar "filedia" vDia)
(setvar "cmdecho" vEcho)
(princ)
)

;;;------------------------------------------------------------------------------
;;;
;;;Finds the folder name by how many folders up supplied in argument
;;;No error checking for too many folders argument
;;;Example:    (pp_GetFolderNameUp 2)
;;;------------------------------------------------------------------------------
(defun pp_GetFolderNameUp(sNo /)
 (vl-load-com)
 (setq sPath (pp_StrRev (getvar "dwgprefix")))
 ;Get to folder above
 (repeat sNo
   (setq sPath (substr sPath (+ (vl-string-search "\" sPath)  3)))
   ) ;repeat
 ;Trim leftover folder name
 (setq sPath (pp_StrRev (substr sPath (+ (vl-string-search "\" sPath)  1))))
 spath
 ) ;defun
;------------------------------------------------------------------------------
;pp_StrRev: String reverse
;------------------------------------------------------------------------------
(defun pp_StrRev (STR)
 (vl-list->string(reverse(vl-string->list STR)))
)

;;  CAB 10/07/08
;; (splitdirs "c:\\123\\456\\789") returns ("c:" "123" "456" "789")
(defun splitdirs (str / lst pos)
 (while (or (setq pos (vl-string-search "\" str))
            (setq pos (vl-string-search "/" str)))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (if (> (strlen str) 0) (setq lst (cons str lst)))
 (reverse lst)
)

(defun c:test(/ dir lst NewDir idx)
 (setq dir "M:\\1234\\Target Dir\\dwgs\\electrical")
 (setq lst (splitdirs dir))
 (setq NewDir (car lst))
 (setq idx 0)
 (while (/= "DWGS" (strcase (nth (setq idx (1+ idx)) lst)))
   (setq NewDir (strcat NewDir "\" (nth idx lst)))
 )
 (print NewDir)
 (princ)
)
;;  CAB 10/07/08
;; (splitdirs "c:\\123\\456\\789") returns ("c:" "123" "456" "789")
(defun splitdirs (str / lst pos)
 (while (or (setq pos (vl-string-search "\" str))
            (setq pos (vl-string-search "/" str)))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (if (> (strlen str) 0) (setq lst (cons str lst)))
 (reverse lst)
)

Command: test
"M:\\1234\\Target Dir"

(defun c:BindIt (/)
;;  CAB 10/07/08
;; (splitdirs "c:\\123\\456\\789") returns ("c:" "123" "456" "789")
(defun splitdirs (str / lst pos)
 (while (or (setq pos (vl-string-search "\" str))
            (setq pos (vl-string-search "/" str)))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (if (> (strlen str) 0) (setq lst (cons str lst)))
 (reverse lst)
)
 (setq vDia     (getvar "filedia")
       vEcho    (getvar "cmdecho")
       vPrefix  (getvar "dwgprefix")
       vName    (getvar "dwgname")
       vDate    (rtos (getvar "cdate") 2 6)
       vYear    (substr vDate 1 4)
       vMonth   (substr vDate 5 2)
       vDay     (substr vDate 7 2)
       vDateStr (strcat vYear "-" vMonth "-" vDay)
 )
 ;;  remove the last 2 dirs
 (setq lst (reverse (cddr (reverse (splitdirs vPrefix)))))
 (setq vPrefix "")
 (mapcar '(lambda(x) (setq vPrefix (strcat vPrefix x "\"))) lst)
 
 (setvar "filedia" 0)
 (setvar "cmdecho" 0)
 (initget "Bound Email")
 (setq vDir (getkword "\nSave file to [Email/Bound] <Bound>: "))
 (cond
   ((or (null vDir)(= "Bound" vAns))
    (setq vDir (strcat vPrefix "Bound"))
   )
   (t
    (setq vDir (strcat vPrefix "Email"))
   )
 )
 (cond
   ((and (null (vl-file-directory-p vDir))
         (null (vl-mkdir vDir))
     )
    (prompt "\nError - Could not create Folder.")
    )
   (t ; folder exist
     (command ".saveas" "" (strcat vDir "\" vDateStr "-" vName))
   )
 )
    
 (setvar "filedia" vDia)
 (setvar "cmdecho" vEcho)
 (princ)
)