ljfzx 发表于 2017-9-5 16:29:01

有没有将图纸存为当前日期的lisp

例如,会根据当前日期讲drawing1.dwg命名为drawing1-0905.dwg这种的lisp?

elitefish 发表于 2017-9-14 11:05:36

本帖最后由 elitefish 于 2017-9-14 13:57 编辑

存为今天.LSP
序号代码
01.
02.
03.
04.
05.
06.
07.
08.
09.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
(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)
)


669423907 发表于 2017-9-13 23:06:46

;one6363 2011-12-6 http://bbs.yxcax.com/thread-79329-4-1.html
;Andyhon 2016-7-20 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=173164
(defun c:fw()
(cond
    ((setq na (entsel "\n请选取图形名称:"))
   (setq na (cdr (assoc 1 (entget (car na)))))
    )
    (T (setq na ""
;(getstring "\n请输入图形名称:")
))
)

(princ "\n请选择输出对象: ")
(setq      ss   (ssget ":s" '((0 . "~xline")(0 . "~ray")))
      date   (rtos (getvar "cdate") 2 6)
      年   (substr date 3 2)      ;1 4
      月   (substr date 5 2)
      日   (substr date 7 2)
      tim    (substr date 10)
      时   (substr tim 1 2)
      分   (substr tim 3 2)
      秒   (substr tim 5 2)
      datime (strcat "(" 年 "" 月 "" 日 "_" 时 "" 分 "" 秒 ")")

      desk   (strcat "E:/00/发外图纸/" na datime)
)
(command "WBLOCK" desk "" '(0 0 0) ss "")
;; 把选择
(command "oops")

(if (/= ss nil)(progn
(vlax-invoke
    (vlax-create-object "wscript.shell")
    'run
    "E:\\00\\CAD外挂\\打开发外图纸.vbs"
)
(princ"\n选择的对象已完成输出")
))

(princ)
)

自贡黄明儒 发表于 2017-9-5 16:41:18

有呀,G版就发过,每隔一段时间就自动生成一个。

liwen888888 发表于 2017-9-5 20:49:33

记得好早就有了,好像叫“存为今天”

ljfzx 发表于 2017-9-6 08:58:07

自贡黄明儒 发表于 2017-9-5 16:41
有呀,G版就发过,每隔一段时间就自动生成一个。

G版的我看了是生成一个但是不能覆盖原有的,只是起个备份的作用

ljfzx 发表于 2017-9-6 08:58:21

liwen888888 发表于 2017-9-5 20:49
记得好早就有了,好像叫“存为今天”

存为今天不是lisp,是vlx

ljfzx 发表于 2017-9-18 10:18:31

elitefish 发表于 2017-9-14 11:05
存为今天.LSP

信大神的程序真的很好,就是精确到秒太夸张了,而且实测好像也没有出现备份文件

ljfzx 发表于 2017-9-18 10:49:56

elitefish 发表于 2017-9-14 11:05
存为今天.LSP

可不可以改成只精确到分钟的,我自己尝试修改,但是失败了

wyl219 发表于 2018-6-16 20:05:55

elitefish 发表于 2017-9-14 11:05
存为今天.LSP

你好,请问vlax-get是什么函数?为什么我在CAD2016帮助里面找不到这个函数?
页: [1] 2
查看完整版本: 有没有将图纸存为当前日期的lisp