[编程交流] 使用将dwg保存在子文件夹中

 
;; 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

(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)
   )
 )
)

(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)
)