目录Lisp 乐筑天下 - Powered by Discuz! Archiver

neekcotrack 发表于 2022-7-6 17:15:19

目录Lisp

有没有办法让它返回两个文件夹来保存绑定的文件夹或电子邮件？

示例：M:\1234\dwgs\electric，我希望它将文件夹保存在1234文件夹中，该文件夹将是两个文件夹。也可以将其视为dwgs文件夹之前的文件夹。提前感谢您所做的一切。

(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 <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)
)

谢谢你的帮助！！！

borgunit 发表于 2022-7-6 17:18:49

这会将路径修剪两个文件夹

;;;------------------------------------------------------------------------------
;;;
;;;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 发表于 2022-7-6 17:24:23

另一种方式：
;;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)
)

neekcotrack 发表于 2022-7-6 17:26:09

有没有办法返回到DWG之前的文件夹，不管它后面有多少个文件夹。在我已经给出的Lisp程序中，我应该把你猜到的放在哪里？

再次感谢

neekcotrack 发表于 2022-7-6 17:30:33

任何帮助！！

CAB 发表于 2022-7-6 17:31:22

(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)
)

neekcotrack 发表于 2022-7-6 17:35:58

当我做你的是什么都不做？怎么会？

CAB 发表于 2022-7-6 17:38:43

测试lisp从以下内容开始：
“M:\\1234\\Target Dir\\dwgs\\electrical”
并返回以下内容：
Command: test

"M:\\1234\\Target Dir"

这是一个工具，一个子例程。
您需要帮助将其集成到lisp中吗？

neekcotrack 发表于 2022-7-6 17:42:31

是的，我迷路了！！！！

CAB 发表于 2022-7-6 17:45:26

在这里，您可以调试它：眨眼：：眨眼：
(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 <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)
)

页: [1] 2

乐筑天下's Archiver

目录Lisp