使用将dwg保存在子文件夹中
你好我正在使用我找到的一个非常有用的lisp代码（稍加修改），它用日期和时间戳保存dwg文件。
有人能帮我把日期和时间显示在文件名之前吗？
例如，我希望文件读取“test 09-09-16\u 12.22'28.dwg”，而不是“09-09-16\u 12.22'28”test.dwg”
更重要的是，每个文件是否可以保存在自动创建的子文件夹中，该子文件夹与文件同名？因此，如果文件名为“test.dwg”，则会自动创建一个子文件夹，并将其命名为“test”，而无需用户进行任何输入，其中包含所有保存的文件。
提前谢谢你。
这是我正在使用的代码：
;; TED KRUSH 9/23/02
;;; Routine that was created @ Southern Maine Technical College.
;;; Saves Drawing an eariler version and then resaves as
;;; orginal version to maitain defualt save.
;; UPDATED 02/02/03 Added Date Sub-Routine
;; UPDATED 03/11/05 Revise version save 2002/R14 to 2004/2000 per upgrade to Autocad 2005 version
;; UPDATED 04/05/06 Adde StrPath Sub-Rountine, so as new file can be saved to folder.
;;;; *** Now We go to to Commerical Break for the Typical Legal Mumbo Jumbo ***
;;;; Permission to use, copy, modify, and distribute this software
;;;; for any purpose and without fee is hereby granted.
;;;;
;;;; I PROVIDE THIS PROGRAM "AS IS" AND WITH ALL FAULTS. I SPECIFICALLY DISCLAIM ANY
;;;; IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. I DO NOT
;;;; WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.
(defun c:scon ()
;;Error Trap utilizing the TedError Function
(command ".undo" "m")
(setq old_error *error*)
(setq *error* tederror)
;;Start of Date defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun TODAY (/ d yr mo day hr m s) ;define the function and declare all variabled local
(setq d (rtos (getvar "CDATE") 2 6)
;get the date and time and convert to text
yr (substr d 3 2) ;extract the year
mo (substr d 5 2) ;extract the month
day (substr d 7 2) ;extract the day
hr (substr d 10 2) ;extract the hour
m (substr d 12 2) ;extract the minute
s (substr d 14 2) ;extract the second
)
(setq dates (strcat mo "-" day "-" yr "_" hr "." m "'" s"'' ")) ;string 'em together
(princ)
)
;;End of Date defun
;;Start of StrPath defun~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun StrPath ()
(setq OldName (getvar "dwgname"))
;; Extracts the Drawing File Name
(setq OldPath (getvar "dwgprefix"))
;; Extracts the Drawing Location
(setq NewPath (vl-string-subst
"\\Transfer-Outgoing\\"
"\\Drawings\\"
OldPath
)
)
(setq OldFile (strcat OldPath OldName))
; Text String for Old File
(setq NewFile (strcat NewPath dates Oldname))
; Text String for New File
(princ)
)
;;End of StrPath defun
;; Main Rountine
(today)
(StrPath)
(vl-mkdir NewPath)
(setvar "expert" 4)
(command "saveas" "2004" NewFile) ;New file with date Prefix
(command "saveas" "2004" OldFile) ;Saves back to the Orginal File.
(setvar "expert" 0)
(setq *error* old_error)
(princ)
)
请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。
Your Code Here=
Your Code Here 我正在努力，通过反复试验，我找到了创建与dwg文件同名的空子文件夹的代码。如果有人能合并它
对于代码的其余部分，我将不胜感激，因为我完全不懂这一点。
(vl-mkdir (vl-filename-base (getvar "dwgname")))
(defun c:scon ( / path oldExpert time)
(if (zerop (getvar 'dwgtitled))
(princ "\nError: save drawing first ")
(progn
(setq oldExpert (getvar 'expert))
(setvar 'expert 4)
(command "_.saveas" "_2004" "") ; Save original file.
(setvar 'expert oldExpert)
(setq time (vl-file-systime (strcat (getvar 'dwgprefix) (getvar 'dwgname))))
(setq path
(strcat
(vl-string-subst "\\Transfer-Outgoing\\" "\\Drawings\\" (getvar 'dwgprefix))
(vl-filename-base (getvar 'dwgname))
"\\"
)
)
(vl-mkdir path)
(setq path ; Add drawing name to path.
(strcat
path ; Ending in "\\".
(vl-filename-base (getvar 'dwgname))
" "
(strcat (if (> 10 (nth 1 time)) "0" "") (itoa (nth 1 time))) ; Month.
"-"
(strcat (if (> 10 (nth 3 time)) "0" "") (itoa (nth 3 time))) ; Day of the month.
"-"
(substr (itoa (nth 0 time)) 3) ; Year.
"_"
(strcat (if (> 10 (nth 4 time)) "0" "") (itoa (nth 4 time))) ; Hour.
"."
(strcat (if (> 10 (nth 5 time)) "0" "") (itoa (nth 5 time))) ; Minute.
"'"
(strcat (if (> 10 (nth 6 time)) "0" "") (itoa (nth 6 time))) ; Second.
"''"
".dwg"
)
)
(vl-file-delete path) ; Just in case...
(vl-file-copy (strcat (getvar 'dwgprefix) (getvar 'dwgname)) path)
)
)
) 罗伊，我真的很感谢你的帮助！我尝试了您的代码，但它没有将任何内容保存到创建的文件夹中，并返回错误：“命令：；错误：错误的参数类型：consp nil”。
有什么想法吗？不过，谢谢你的努力和时间。 显然，在AutoCAD中，（vl文件系统）存在问题。BricsCAD没有这个问题。
试试这个：
(defun c:scon ( / path oldExpert time)
(if (zerop (getvar 'dwgtitled))
(princ "\nError: save drawing first ")
(progn
(setq oldExpert (getvar 'expert))
(setvar 'expert 4)
(command "_.saveas" "_2004" "") ; Save original file.
(setvar 'expert oldExpert)
(setq time (getvar 'tdupdate))
(setq path
(strcat
(vl-string-subst "\\Transfer-Outgoing\\" "\\Drawings\\" (getvar 'dwgprefix))
(vl-filename-base (getvar 'dwgname))
"\\"
)
)
(vl-mkdir path)
(setq path ; Add drawing name to path.
(strcat
path ; Ending in "\\".
(vl-filename-base (getvar 'dwgname))
(menucmd (strcat "m=$(EDTIME," (rtos time 2", mo-dd-yy_hh.mm'ss'')"))
".dwg"
)
)
(vl-file-delete path) ; Just in case...
(vl-file-copy (strcat (getvar 'dwgprefix) (getvar 'dwgname)) path)
)
)
(princ)
) 罗伊，它工作得很好！我真是太感谢你了，我一个人永远也做不到！
页:
[1]