有没有一个lsp可以在dwg后面添加当前系统的日期？
本帖最后由 ljfzx 于 2022-9-7 19:24 编辑画图的时候，经常想备份当前画的图纸，但是在论坛里面搜索了良久也没有一个合适的，请问有没有一个lsp可以做到以下的要求：
1.在当前图纸dwg文件名加上后缀“YYYYMODD”（就是当前保存的年月日）。
2.每次保存的时候可以检测此文件名的后缀日期是否与系统日期一致，如果相同就正常保存，如果不同的话，就把当前的文档备份到图纸目录下的“备份目录”去，并且自动修改当前文档的日期与系统日期一致。
3.例如当前系统日期为20220901，图档的后缀日期也是20220901，则直接保存
如果当前系统日期为20220901，图档的后缀日期为20220831，则备份0831的图纸到当前图档的文件夹下的“备份”文件夹内,并把当前的0831文档后缀名修改为0901并保存。
这样能够确保每天的修改量都可以备份下来，请问有大神可以做到吗？
自己解决了，还是得靠自己啊。。
(defun c:bak ( /oldpath oldname oldname1 midname newname)
;;;;;下面的程序为获取文件原始的文件名及路径
(setq oldpath (getvar "DWGPREFIX"));获取文件n路径
(setq oldname (getvar "dwgname"));获取文件名
(vl-mkdir (strcat (getvar 'DWGPREFIX) "图纸备份")) ;在源目录下创建一个名称为BAK的文件夹
(setq oldname1 (vl-filename-base (getvar "DWGNAME")))
;将去掉路径和后缀名的文件名赋值给变量
(vl-file-copy
(strcat oldpath oldname1 ".dwg")
(strcat (getvar 'DWGPREFIX)
"图纸备份\\"
(cadr (fnsplitl (getvar 'DWGNAME)))
".dwg"
)
nil
)
;;;;;下面的程序为以现在的时刻时间加到原文件名后并保存
(if (wcmatch oldname "* *.dwg")
(setq midname (substr oldname 1 (vl-string-search " " oldname)))
(setq midname (substr oldname 1 (- (strlen oldname)4)))
)
(setq newname (strcat midname " " (menucmd "M=$(edtime,$(getvar,date),YYYYMODD)") ".dwg"))
(command "saveas" ""(strcat oldpath newname) "y")
;;;;;下面的程序为删除加上新时刻时间前的文件
(vl-file-delete (strcat oldpath oldname1 ".dwg"))
(vl-file-delete (strcat oldpath oldname1 ".bak"))
(princ)
)
这个可能需要反应器吧，思路倒简单，利用（getvar "cdate") 获取当前日期 ，用(Getvar "dwgname")等变量"获取当前文件名和路径，反应器检测到保存动作时候调用和判断修改。 没啥意义！！ 第一个不行啊 文件不关闭不可以改名 已经有了，仔细搜。
;找到一个存为今天
(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-directoryfullname))
(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)
) baitang36 发表于 2022-9-7 07:58
;找到一个存为今天
(defun C:EF_TodaySave ( / name basename ext fullname bakname path time newname) ...
感谢明经大神的分享，谢谢～ czb203 发表于 2022-9-7 09:06
感谢明经大神的分享，谢谢～
不要感谢我，这不是我写的，是搜到的。没发现作者信息。作者看到后自己认领吧。
我不是大神，只是个业余爱好者。很高兴和大家一起玩。 飞雪神光 发表于 2022-9-6 21:42
第一个不行啊 文件不关闭不可以改名
用saveas应该可以 baitang36 发表于 2022-9-7 07:58
;找到一个存为今天
(defun C:EF_TodaySave ( / name basename ext fullname bakname path time newname) ...
这个程序不能在当前文件夹下自动建立备份文件夹并备份到这里啊。只能改当前名称
页:
[1]
2