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

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

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

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

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

[EF_SaveToday]存为今天.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-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)
  )

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

;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

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

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

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

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

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

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

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

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

存为今天不是lisp，是vlx

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

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

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

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

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

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

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

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

你好,请问vlax-get是什么函数?为什么我在CAD2016帮助里面找不到这个函数?

账号		自动登录	找回密码
密码			注册

[提问] 有没有将图纸存为当前日期的lisp

评分