文件另存lisp，求帮助能判断一下时间格式，只保留最新的时间，免得文件重命名越来...

tranney

文件另存lisp，求帮助能判断一下时间格式，只保留最新的时间，免得文件重命名越来越长，谢谢

1. ;;直接按时间更改名字另保并打开目录
   
2. (defun c:sav ( / date dwgtitled newname oldname path)
   
3.   (if (= (getvar "DWGTITLED") 0)
   
4.     (ALERT "请先保存文件!")
   
5.     (progn
   
6.       (setq path (getvar "DWGPREFIX")
   
7.       oldname (vl-filename-base (getvar "DWGNAME"))
   
8.       )
   
9.       (setq date (menucmd "M=$(edtime,$(getvar,date),[YYYY-MO-DD]-[HH-MM-SS])"))
   
10.       (setq newname (strcat path oldname date))
    
11.       (command "_.save" newname)
    
12.       (princ (strcat "\n---本图已另存为" newname ".dwg"))
    
13.     )
    
14.   )
    
15.   (initget "Q")
    
16.   (setq key (getkword "\n本图已另存是否打开另存文件夹 [打开(Q)/ <不打开（默认）>"))
    
17.   (if (= key "Q")
    
18.     (startapp (strcat "explorer /select, " (getvar "dwgprefix") (getvar "dwgname") ", /e"))
    
19.   )
    
20.     (princ)
    
21. )
    

;;直接按时间更改名字另保并打开目录<br /> (defun c:sav ( / date dwgtitled newname oldname path)<br />   (if (= (getvar "DWGTITLED") 0)<br />     (ALERT "请先保存文件!")<br />     (progn<br />       (setq path (getvar "DWGPREFIX")<br />       oldname (vl-filename-base (getvar "DWGNAME"))<br />       )<br />       (setq date (menucmd "M=$(edtime,$(getvar,date),[YYYY-MO-DD]-[HH-MM-SS])")) <br />       (setq newname (strcat path oldname date))<br />       (command "_.save" newname)<br />       (princ (strcat "\n---本图已另存为" newname ".dwg"))<br />     )<br />   )<br />   (initget "Q")<br />   (setq key (getkword "\n本图已另存是否打开另存文件夹 [打开(Q)/ <不打开（默认）>"))<br />   (if (= key "Q")<br />     (startapp (strcat "explorer /select, " (getvar "dwgprefix") (getvar "dwgname") ", /e"))<br />   )<br />     (princ)<br /> )<br />

ㄘ丶转裑ㄧ灬

暂时没弄懂这样另存的意义是什么。。
建议去看下G版的自动备份图纸
http://bbs.mjtd.com/forum.php?mo ... 1521&fromuid=401847

或者G版的另一个备份图纸
http://bbs.mjtd.com/thread-101512-1-1.html

ZZXXQQ

2. ;;直接按时间更改名字另保并打开目录
   
3. (defun c:sav ( / date dwgtitled newname oldname path)
   
4.   (if (= (getvar "DWGTITLED") 0)
   
5.     (ALERT "请先保存文件!")
   
6.   (progn
   
7.     (setq path (getvar "DWGPREFIX")
   
8.           oldname (vl-filename-base (getvar "DWGNAME")))
   
9.     (setq date (menucmd "M=$$(edtime,$$(getvar,date),[YYYY-MO-DD]-[HH-MM-SS])"))
   
10.     (if (wcmatch oldname (strcat "*" (substr date 1 4) "*")) (progn
    
11.      (setq n 1)
    
12.      (while (/= (substr date 1 4) (substr oldname n 4)) (setq n (1+ n)))
    
13.      (setq oldname (substr oldname 1 n))
    
14.     ))
    
15.     (setq newname (strcat path oldname date))
    
16.     (command "_.save" newname)
    
17.     (princ (strcat "\n---本图已另存为" newname ".dwg"))
    
18.   ))
    
19.   (initget "Q")
    
20.   (setq key (getkword "\n本图已另存是否打开另存文件夹 [打开(Q)/ <不打开（默认）>"))
    
21.   (if (= key "Q")
    
22.     (startapp (strcat "explorer /select, " (getvar "dwgprefix") (getvar "dwgname") ", /e"))
    
23.   )
    
24.   (princ)
    
25. )
    

;;直接按时间更改名字另保并打开目录<br /> (defun c:sav ( / date dwgtitled newname oldname path)<br />   (if (= (getvar "DWGTITLED") 0)<br />     (ALERT "请先保存文件!")<br />   (progn<br />     (setq path (getvar "DWGPREFIX")<br />           oldname (vl-filename-base (getvar "DWGNAME")))<br />     (setq date (menucmd "M=$$(edtime,$$(getvar,date),[YYYY-MO-DD]-[HH-MM-SS])"))<br />     (if (wcmatch oldname (strcat "*" (substr date 1 4) "*")) (progn<br />      (setq n 1)<br />      (while (/= (substr date 1 4) (substr oldname n 4)) (setq n (1+ n)))<br />      (setq oldname (substr oldname 1 n))<br />     ))<br />     (setq newname (strcat path oldname date))<br />     (command "_.save" newname)<br />     (princ (strcat "\n---本图已另存为" newname ".dwg"))<br />   ))<br />   (initget "Q")<br />   (setq key (getkword "\n本图已另存是否打开另存文件夹 [打开(Q)/ <不打开（默认）>"))<br />   (if (= key "Q")<br />     (startapp (strcat "explorer /select, " (getvar "dwgprefix") (getvar "dwgname") ", /e"))<br />   )<br />   (princ)<br /> )<br />

tranney

我打开了Drawing1[2014-11-30]-[09-08-14].dwg
使用命令: sav
"C:\tangent\TWT9\sys18x64\Drawing1[2014-11-30]-[09-08-14]$ $(EDTIME,??) ":  
无效文件名。

---本图已另存为C:\tangent\TWT9\sys18x64\Drawing1[2014-11-30]-[09-08-14]$ $(EDTIME,??)
.dwg
麻烦z版帮忙修改一下，谢谢了

maiko

图纸另存为实际上就是复制一份,建议参考函数:vl-file-copy

tranney

哎呀呀，等了这么久，看到了一个处理字符串的帖子，然后自己处理了一下居然成功了，
另存的文件=文件名-[年-月-日][时-分-秒]
希望大家喜欢

1. ;主函数
   
2. (defun c:sav ( / date dwgtitled newname oldname oldname1 path)
   
3.   (if (= (getvar "DWGTITLED") 0)
   
4.     (ALERT "请先保存文件!")
   
5.     (progn
   
6.       (setq path (getvar "DWGPREFIX")
   
7.       oldname (vl-filename-base (getvar "DWGNAME"))
   
8.       )
   
9. (setq oldname1 (HH:GetBeforeStr1 oldname "-"))
   
10. 
    
11.       (setq date (menucmd "M=$(edtime,$(getvar,date),-[YYYY-MO-DD][HH-MM-SS])"))
    
12.       (setq newname (strcat path oldname1 date))
    
13.       (command "_.saveas" "" newname "")
    
14.       (princ (strcat "\n---本图已另存为" newname ".dwg"))
    
15.     )
    
16.   )
    
17. )
    
18. ;子函数1
    
19. (defun HH:GetBeforeStr1 (str st);区分大小写
    
20.   (car (xd::string:regexps (strcat "[^" st "]+") str "I"))
    
21. )
    
22. ;子函数2
    
23. (defun XD::String:RegExpS (pat str key / end keys matches x)
    
24.   (if (not *xxvbsexp)
    
25.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
    
26.   )
    
27.   (vlax-put *xxvbsexp 'Pattern pat);;;;;;是'Pattern出错的，
    
28.   (if (not key)
    
29.     (setq key "")
    
30.   )
    
31.   (setq key (strcase key))
    
32.   (setq keys '(("I" "IgnoreCase") ("G" "Global")
    
33.          ("M" "Multiline")
    
34.         )
    
35.   )
    
36.   (mapcar
    
37.     '(lambda (x)
    
38.        (if (wcmatch key (strcat "*" (car x) "*"))
    
39.          (vlax-put *xxvbsexp (read (cadr x)) 0)
    
40.          (vlax-put *xxvbsexp (read (cadr x)) -1)
    
41.        )
    
42.      )
    
43.     keys
    
44.   )
    
45.   (setq matches (vlax-invoke *xxvbsexp 'Execute str))
    
46.   (vlax-for x matches (setq end (cons (vla-get-value x) end)))
    
47.   (reverse end)
    
48. )
    

;主函数<br /> (defun c:sav ( / date dwgtitled newname oldname oldname1 path)<br />   (if (= (getvar "DWGTITLED") 0)<br />     (ALERT "请先保存文件!")<br />     (progn<br />       (setq path (getvar "DWGPREFIX")<br />       oldname (vl-filename-base (getvar "DWGNAME"))<br />       )<br /> (setq oldname1 (HH:GetBeforeStr1 oldname "-"))<br /> <br />       (setq date (menucmd "M=$(edtime,$(getvar,date),-[YYYY-MO-DD][HH-MM-SS])")) <br />       (setq newname (strcat path oldname1 date))<br />       (command "_.saveas" "" newname "")<br />       (princ (strcat "\n---本图已另存为" newname ".dwg"))<br />     )<br />   )<br /> )<br /> ;子函数1<br /> (defun HH:GetBeforeStr1 (str st);区分大小写<br />   (car (xd::string:regexps (strcat "[^" st "]+") str "I"))<br /> )<br /> ;子函数2<br /> (defun XD::String:RegExpS (pat str key / end keys matches x)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat);;;;;;是'Pattern出错的，<br />   (if (not key)<br />     (setq key "")<br />   )<br />   (setq key (strcase key))<br />   (setq keys '(("I" "IgnoreCase") ("G" "Global")<br />          ("M" "Multiline")<br />         )<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />          (vlax-put *xxvbsexp (read (cadr x)) 0)<br />          (vlax-put *xxvbsexp (read (cadr x)) -1)<br />        )<br />      )<br />     keys<br />   )<br />   (setq matches (vlax-invoke *xxvbsexp 'Execute str))<br />   (vlax-for x matches (setq end (cons (vla-get-value x) end)))<br />   (reverse end)<br /> )<br />

start4444