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

neekcotrack 发表于 2022-7-6 17:48:24

我让它工作了，但它没有把文件放在绑定/电子邮件文件夹中，然后是一个创建日期为2008-10-22的文件夹。如果将其放在绑定/电子邮件文件夹中，并且只将日期放在文件名的开头。为什么会这样。

CAB 发表于 2022-7-6 17:50:46

为了让它工作，你做了什么改变吗？
我更改了代码来实现这一点，认为您不希望为每个日期创建文件夹，而只是创建唯一的文件名。

我真傻。
如果你愿意，我可以修改一下。

neekcotrack 发表于 2022-7-6 17:53:39

不，你什么都做了。

CAB 发表于 2022-7-6 17:56:37

修订代码：
(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"))
)
)

;;The following is to create a seperate directory for each date
(setq vDir (strcat vDir "\\" vDateStr))

(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))
(command ".saveas" "" (strcat vDir "\\" vName))
)
)

(setvar "filedia" vDia)
(setvar "cmdecho" vEcho)
(princ)
)

neekcotrack 发表于 2022-7-6 18:01:40

好的，这很好。如果我的C驱动器上有一个绘图，但如果我的m驱动器上有一些东西，它会一直说无法创建文件夹，为什么。我甚至试着把c:\\改成m:\\但仍然是一样的。为什么？

CAB 发表于 2022-7-6 18:05:22

问题是绑定文件夹或电子邮件文件夹是否尚未创建。
这应该可以解决它。
(defun c:BindIt (/ LST VANS VDATE VDATESTR VDAY VDIA VDIR VECHO VMONTH VNAME VPREFIX VYEAR X)

;;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"))
(vl-mkdir vDir)
)
(t
(setq vDir (strcat vPrefix "Email"))
(vl-mkdir vDir)
)
)

(if (vl-file-directory-p vDir)
(progn
;;The following is to create a seperate directory for each date
(setq vDir (strcat vDir "\\" vDateStr))

(cond
   ((and (null (vl-file-directory-p vDir))
         (null (vl-mkdir vDir))
   )
   (prompt (strcat "\nError - Could not create Folder: " vDir))
   )
   (t ; folder exist
   ;;(command ".saveas" "" (strcat vDir "\\" vDateStr "-" vName))
   (command ".saveas" "" (strcat vDir "\\" vName))
   )
)
)
(prompt (strcat "\nError - Could not create Folder: " vDir))
)
(setvar "filedia" vDia)
(setvar "cmdecho" vEcho)
(princ)
)

neekcotrack 发表于 2022-7-6 18:08:18

谢谢你，真是太棒了。我只是在最后添加了一个东西，它将绑定和清除，然后重新保存

最后我添加了这个。

(command "_.xref" "bind" "*")
(command "_.purge" "" "all" "n" "" "_.purge" "all" "" "n" "" "_.purge" "all" "" "n")
(command ".save")
)

谢谢你的帮助，我希望这能帮助别人。

CAB 发表于 2022-7-6 18:10:30

把你的代码放在这一部分，这样只有在没有错误的情况下才会执行。
   (t ; folder exist
   ;;(command ".saveas" "" (strcat vDir "\\" vDateStr "-" vName))
   (command ".saveas" "" (strcat vDir "\\" vName))
   ;;Add your code here
   )

neekcotrack 发表于 2022-7-6 18:12:57

有没有一种方法可以将清除和绑定放在开头，然后可以代替savas来执行aectoacad。在aectoacad到文件夹位置之前，将执行绑定和清除操作，而不会更改任何内容。

CAB 发表于 2022-7-6 18:16:53

哎呀，用这个：
   (t ; folder exist
   (command "_.xref" "bind" "*")
   (command "_.purge" "" "all" "n" "" "_.purge" "all" "" "n" "" "_.purge" "all" "" "n")
   ;;(command ".saveas" "" (strcat vDir "\\" vDateStr "-" vName))
   (command ".saveas" "" (strcat vDir "\\" vName))
   )

页: 1 [2]

乐筑天下's Archiver