有没有一个lsp可以在dwg后面添加当前系统的日期？

ljfzx

画图的时候，经常想备份当前画的图纸，但是在论坛里面搜索了良久也没有一个合适的，请问有没有一个lsp可以做到以下的要求：


1.在当前图纸dwg文件名加上后缀“YYYYMODD”（就是当前保存的年月日）。
2.每次保存的时候可以检测此文件名的后缀日期是否与系统日期一致，如果相同就正常保存，如果不同的话，就把当前的文档备份到图纸目录下的“备份目录”去，并且自动修改当前文档的日期与系统日期一致。
3.例如当前系统日期为20220901，图档的后缀日期也是20220901，则直接保存
如果当前系统日期为20220901，图档的后缀日期为20220831，则备份0831的图纸到当前图档的文件夹下的“备份”文件夹内,并把当前的0831文档后缀名修改为0901并保存。

这样能够确保每天的修改量都可以备份下来，请问有大神可以做到吗？



自己解决了，还是得靠自己啊。。

2. (defun c:bak ( /  oldpath oldname oldname1 midname newname)
   
3. ;;;;;下面的程序为获取文件原始的文件名及路径
   
4. (setq oldpath (getvar "DWGPREFIX"));获取文件n路径
   
5. (setq oldname (getvar "dwgname"));获取文件名
   
6.   (vl-mkdir (strcat (getvar 'DWGPREFIX) "图纸备份"))               ;在源目录下创建一个名称为BAK的文件夹
   
7.   (setq oldname1 (vl-filename-base (getvar "DWGNAME")))
   
8.                                         ;将去掉路径和后缀名的文件名赋值给变量
   
9.   (vl-file-copy
   
10.    (strcat oldpath oldname1 ".dwg")
    
11.     (strcat (getvar 'DWGPREFIX)
    
12.                "图纸备份\"
    
13.                (cadr (fnsplitl (getvar 'DWGNAME)))
    
14.                ".dwg"
    
15.        )
    
16.     nil
    
17.   )
    
18. ;;;;;下面的程序为以现在的时刻时间加到原文件名后并保存
    
19.    (if (wcmatch oldname "* *.dwg")
    
20.        (setq midname (substr oldname 1 (vl-string-search " " oldname)))
    
21.        (setq midname (substr oldname 1 (- (strlen oldname)  4)))
    
22.    )                                      
    
23.    (setq newname (strcat midname " " (menucmd "M=$(edtime,$(getvar,date),YYYYMODD)") ".dwg"))
    
24.    (command "saveas" ""  (strcat oldpath newname) "y")
    
25. 
    
26. ;;;;;下面的程序为删除加上新时刻时间前的文件
    
27.    (vl-file-delete (strcat oldpath oldname1 ".dwg"))
    
28.    (vl-file-delete (strcat oldpath oldname1 ".bak"))
    
29.    (princ)
    
30. )
    
31. 
    
32. 
    

(defun c:bak ( /  oldpath oldname oldname1 midname newname)<br /> ;;;;;下面的程序为获取文件原始的文件名及路径<br /> (setq oldpath (getvar "DWGPREFIX"));获取文件n路径<br /> (setq oldname (getvar "dwgname"));获取文件名<br />   (vl-mkdir (strcat (getvar 'DWGPREFIX) "图纸备份"))               ;在源目录下创建一个名称为BAK的文件夹<br />   (setq oldname1 (vl-filename-base (getvar "DWGNAME")))<br />                                         ;将去掉路径和后缀名的文件名赋值给变量<br />   (vl-file-copy<br />    (strcat oldpath oldname1 ".dwg")<br />     (strcat (getvar 'DWGPREFIX)<br />                "图纸备份\"<br />                (cadr (fnsplitl (getvar 'DWGNAME)))<br />                ".dwg"<br />        )<br />     nil<br />   )<br /> ;;;;;下面的程序为以现在的时刻时间加到原文件名后并保存<br />    (if (wcmatch oldname "* *.dwg")<br />        (setq midname (substr oldname 1 (vl-string-search " " oldname)))<br />        (setq midname (substr oldname 1 (- (strlen oldname)  4)))<br />    )                                      <br />    (setq newname (strcat midname " " (menucmd "M=$(edtime,$(getvar,date),YYYYMODD)") ".dwg"))<br />    (command "saveas" ""  (strcat oldpath newname) "y")<br /> <br /> ;;;;;下面的程序为删除加上新时刻时间前的文件<br />    (vl-file-delete (strcat oldpath oldname1 ".dwg"))<br />    (vl-file-delete (strcat oldpath oldname1 ".bak"))<br />    (princ)<br /> )<br /> <br /> <br />

zhaoxt

这个可能需要反应器吧，思路倒简单，利用（getvar "cdate") 获取当前日期 ，用(Getvar "dwgname")等变量"获取当前文件名和路径，反应器检测到保存动作时候调用和判断修改。

xj6019

没啥意义！！

飞雪神光

第一个不行啊 文件不关闭不可以改名

zhangcan0515

已经有了，仔细搜。

baitang36

;找到一个存为今天
(defun C:EF_TodaySave ( / name basename ext fullname bakname path time newname)
  (setq name (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Name))
  (setq fullname (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'FullName))
  (setq path (vl-filename-directory  fullname))
  (setq ext (vl-filename-extension name))
  (setq basename (vl-filename-base name))
  (setq bakname (strcat path "\\" basename ".bak"))
  (setq time (menucmd "m=$(edtime,$(getvar,DATE),YYYY-MO-DD HH-MM-SS)"))
  (cond ((= fullname "")    ;从未存过盘
     (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "SAVE ")
     )
    ((wcmatch (strcase name)  "*`[####-##-## ##-##-##`].DWG")
     (setq newname (strcat path "\\" (substr basename 1 (- (strlen basename) 21)) "[" time "]" ext))
     (if (= (strcase fullname) (strcase newname))
       (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "SAVE ")
       (progn
         (vl-cmdf "SAVEAS" "" newname)
         (if (= (getvar 'ISAVEBAK) 1)    ;检测是否需要备份
           (vl-file-rename fullname (strcat path "\\" (vl-filename-base newname) ".bak"))
           (vl-file-delete fullname)
           )
         (if (vl-file-size bakname) (vl-file-delete bakname))
         )
       )
     )
    (T
     (setq newname (strcat path "\\" basename "[" time "]" ext))
     (vl-cmdf "SAVEAS" "" newname)
     (if (= (getvar 'ISAVEBAK) 1)    ;检测是否需要备份
       (vl-file-rename fullname (strcat path "\\" (vl-filename-base newname) ".bak"))
       (vl-file-delete fullname)
       )
     (if (vl-file-size bakname) (vl-file-delete bakname))
     )
    )
  (princ)
  )

czb203

baitang36 发表于 2022-9-7 07:58
;找到一个存为今天
(defun C:EF_TodaySave ( / name basename ext fullname bakname path time newname) ...

感谢明经大神的分享，谢谢～

baitang36

czb203 发表于 2022-9-7 09:06
感谢明经大神的分享，谢谢～

不要感谢我，这不是我写的，是搜到的。没发现作者信息。作者看到后自己认领吧。
我不是大神，只是个业余爱好者。很高兴和大家一起玩。

ljfzx

飞雪神光 发表于 2022-9-6 21:42
第一个不行啊 文件不关闭不可以改名

用saveas应该可以

ljfzx

baitang36 发表于 2022-9-7 07:58
;找到一个存为今天
(defun C:EF_TodaySave ( / name basename ext fullname bakname path time newname) ...

这个程序不能在当前文件夹下自动建立备份文件夹并备份到这里啊。只能改当前名称