Save a copy of a Dwg file to two locations

April 24, 2019

Thanks for the input guys, I don't see this being some complex coding but just want to make sure I am doing it as efficiently as I can. Thanks for the snipit on SAVEAS rlx, I think I will attempt to make a new SAVE using the SAVEAS function along with Lee's old code from above.

I am basically just getting into LISP, but have a passion and love tinkering. When something finally works it is a great feeling!

May 10, 2019

Haven't done any field testing and the ink is still wet , but just for fun ... so stop bugging & start de-bugging


; qs command line version
(defun c:qs
  ( /
   ; program variables
   regvar regval actDoc acApp olderr folder-type-list org-dwg-path org-dwg-name
   org-dwg-ver org-save-as-type dwg-dxf-version-list
            
   ; dialog variables - not needed for command line version
       
   ; registry variables
   QS-BackupFolderName QS-SubFolderName
   QS-OldFolderString QS-NewFolderString
   QS-UseLispFileToChangeFolderString QS-LispFileNameToChangeFolderString
   QS-CreateDwg QS-DwgAutocadVersion QS-DwgFolderType
   QS-CreateDxf QS-DxfAutocadVersion QS-DxfFolderType
   QS-CreatePdf QS-PdfFolderType QS-PdF-PaperSize QS-PdF-PlotStyle QS-ZoomExtents
   QS-PurgeAll QS-Audit QS-SaveAllTabs QS-AppendTabName QS-IncludeModelSpaceTab
  )
  (qs_init_variables)  (run_qs)  (qs_exit)
  (princ)
)

; qss = qs setup)
(defun c:qss
  ( /
   ; program variables
   regvar regval actDoc acApp olderr folder-type-list org-dwg-path org-dwg-name
   org-dwg-ver org-save-as-type dwg-dxf-version-list
            
   ; dialog variables
   dialog-fn dialog-fp dialog-id MainDialog-rd MainDialog-tl
            
   ; registry variables
   QS-BackupFolderName QS-SubFolderName
   QS-OldFolderString QS-NewFolderString
   QS-UseLispFileToChangeFolderString QS-LispFileNameToChangeFolderString
   QS-CreateDwg QS-DwgAutocadVersion QS-DwgFolderType
   QS-CreateDxf QS-DxfAutocadVersion QS-DxfFolderType
   QS-CreatePdf QS-PdfFolderType QS-PdF-PaperSize QS-PdF-PlotStyle QS-ZoomExtents
   QS-PurgeAll QS-Audit QS-SaveAllTabs QS-AppendTabName QS-IncludeModelSpaceTab
  )
  (qs_init_variables)  (begin_dialog)  (qs_exit)
  (princ)
)

(defun qs_init_variables ()(vl-load-com)
  (defun *error* (s)(qs_exit)(or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*")(princ (strcat "\n** Error: " s " **")))(princ))
  (setq actDoc (vla-get-ActiveDocument (setq acApp (vlax-get-acad-object))) olderr *error*
        org-save-as-type (vla-get-SaveAsType (vla-get-OpenSave (vla-get-Preferences acApp)))
        org-dwg-path (getvar 'dwgprefix) org-dwg-name (getvar 'dwgname) org-dwg-ver (dwgver)
        folder-type-list '("Backup Folder" "Current Folder" "Sub Folder" "Changed Folder"))
  (init_version_lists) (InitDefaultRegistrySettings)(ReadSettingsFromRegistry)(put_pdf_printer)
)

(defun qs_exit () (if dialog-id (unload_dialog dialog-id)) (if dialog-fp (close dialog-fp))
  (if (and dialog-fn (findfile dialog-fn)) (vl-file-delete (findfile dialog-fn)))(setq *error* olderr))


;--- Registry Settings ---------------------------------- Begin Registry Settings ----------------------------------- Registry Settings ---

(defun InitDefaultRegistrySettings ()
  ; regkeys must be strings
  (setq regkey "HKEY_CURRENT_USER\\SOFTWARE\\Rlx_QS\\"
        regvar '(("QS-BackupFolderName" "")("QS-SubFolderName" "")
                 ("QS-OldFolderString" "")("QS-NewFolderString" "")
                 ("QS-UseLispFileToChangeFolderString" "0")("QS-LispFileNameToChangeFolderString" "")
                 ("QS-CreateDwg" "0")("QS-DwgAutocadVersion" "0")("QS-DwgFolderType" "1")
                 ("QS-CreateDxf" "0")("QS-DxfAutocadVersion" "0")("QS-DxfFolderType" "1")
                 ("QS-CreatePdf" "0")("QS-PdfFolderType" "1") ("QS-PdF-PaperSize" "ISO_full_bleed_A3_(420.00_x_297.00_MM)")
                 ("QS-PdF-PlotStyle" "monochrome.ctb")
                 ("QS-ZoomExtents" "0")("QS-PurgeAll" "0")("QS-Audit" "0")("QS-SaveAllTabs" "0")("QS-AppendTabName" "0")
                 ("QS-IncludeModelSpaceTab" "0")
                 ))
  (mapcar '(lambda (x)(set (read (car x)) (cadr x))) regvar)
)

(defun ReadSettingsFromRegistry ()
  (mapcar
    '(lambda (x / n v) (if (setq v (vl-registry-read regkey (setq n (car x)))) (set (read n) v) (vl-registry-write regkey n (cadr x))))
     regvar
  )  
)

(defun WriteSettingsToRegistry ()
  (mapcar
    '(lambda (x) (vl-registry-write regkey (car x) (eval (read (car x)))))
    regvar
  )
)

;--- Registry Settings ----------------------------------- End Registry Settings ------------------------------------ Registry Settings ---


(defun Create_Dialog ( )
  (if (and (setq dialog-fn (vl-filename-mktemp "tmp.dcl")) (setq dialog-fp (open dialog-fn "w")))
    (mapcar
      '(lambda (x)(write-line x dialog-fp))
       (list
         "main : dialog {label=\"Qsave (Rlx 5/'19)\";"
         ":row {"
           ":column {"
             ":boxed_row {label=\"Backup Folder\";"
                ":button {key=\"bt_select_backup_folder\";label=\"Select\";}"
                ":edit_box {key=\"eb_backup_folder\";width=32;}}"
             ":boxed_row {children_fixed_width=true;label=\"Create subfolder in current drawing folder\";"
                ":text {label=\" Subfolder\";}:edit_box {key=\"eb_sub_folder\";width=33;}}"
             ":boxed_row {label=\"Change Folder String\";"
               ":column {spacer;:text {label=\"  Old String\";}"
                        "spacer;:text {label=\"  New String\";}spacer;"
                        ":row {children_fixed_width=true;"
                          ":button {key=\"bt_select_lispfile_to_change_folder_string\";label=\"Lspfile\";}"
                          ":toggle {alignment=bottom;key=\"tg_use_lispfile_to_change_folder_string\";}}spacer;}"
               ":column {:edit_box {key=\"eb_old_folder_string\";edit_width=24;}"
                        ":edit_box {key=\"eb_new_folder_string\";edit_width=24;}"
                        ":edit_box {key=\"eb_lisp_filename_to_change_folder_string\";edit_width=24;}spacer;}}}"
           ":column {"
             ":boxed_row {label=\"Drawing options\";"
               ":column {spacer_0;:toggle {key=\"tg_create_dwg\";label=\"Dwg\";}"
                        ":toggle {key=\"tg_create_dxf\";label=\"Dxf\";}"
                        ":toggle {key=\"tg_create_pdf\";label=\"Pdf\";}}"
               ":column {:popup_list {key=\"pl_dwg_version\";width=16;}"
                        ":popup_list {key=\"pl_dxf_version\";width=16;}"
                        ":button {key=\"bt_pdf_options\";label=\"Pdf Options  ->\";}}"
               ":column {:popup_list {key=\"pl_dwg_folder_type\";width=18;}"
                        ":popup_list {key=\"pl_dxf_folder_type\";width=18;}"
                        ":popup_list {key=\"pl_pdf_folder_type\";width=18;}}}"
             ":boxed_row {label=\"Save options\";"
               ":column {:toggle {key=\"tg_zoom_extents\";label=\"Zoom Extents\";}"
                        ":toggle {key=\"tg_save_all_tabs\";label=\"Save All Tabs\";}"
                        ":toggle {key=\"tg_append_tab_name\";label=\"Append Tab Name\";}}"
               ":column {:toggle {key=\"tg_purge_all\";label=\"Purge All\";}"
                        ":toggle {key=\"tg_include_model_space_tab\";label=\"Include MS-Tab\";}"
                        ":toggle {key=\"tg_audit\";label=\"Audit\";}}"
                        ":row {height=3;}}}}spacer; :text_part {key=\"tp_status\";} spacer; spacer; ok_cancel;}"
        
         "pdf_options : dialog {label=\"PdF Options (Rlx 5/'19)\";"
           ":boxed_row {:column {:edit_box {key=\"eb_pdf_paper_size\";width=40;}"
                                ":edit_box {key=\"eb_pdf_plot_style\";width=40;}}"
                       ":column {:button {key=\"bt_pdf_paper_size\";label=\"Paper Size\";}"
                                ":button {key=\"bt_pdf_plot_style\";label=\"Plot Style\";}}}spacer; spacer; ok_cancel;}"
      )
    )
  )
  (if dialog-fp (close dialog-fp))
)

(defun begin_dialog ( / drv)
  (if (null dialog-fn)(Create_Dialog))
  (if (and (< 0 (setq dialog-id (load_dialog dialog-fn)))(new_dialog "main" dialog-id))
    (progn (update_dialog)(init_dialog_actions)(setq drv (start_dialog))(unload_dialog dialog-id)(vl-file-delete dialog-fn)))
  (cond ((= drv 0)(Main_dialog_cancel)) ((= drv 1)(WriteSettingsToRegistry)(run_qs)) (t (princ "\nOh darn...")))
)

(defun update_dialog ()
  (setq MainDialog-tl
    '((QS-BackupFolderName "eb_backup_folder")  (QS-SubFolderName "eb_sub_folder")
      (QS-OldFolderString "eb_old_folder_string") (QS-NewFolderString "eb_new_folder_string")
      (QS-UseLispFileToChangeFolderString  "tg_use_lispfile_to_change_folder_string")
      (QS-LispFileNameToChangeFolderString  "eb_lisp_filename_to_change_folder_string")    
      (QS-CreateDwg "tg_create_dwg")   (QS-CreateDxf "tg_create_dxf")
      (QS-CreatePdf "tg_create_pdf")
      (QS-ZoomExtents "tg_zoom_extents")  (QS-PurgeAll "tg_purge_all")
      (QS-Audit "tg_audit")    (QS-SaveAllTabs "tg_save_all_tabs")
      (QS-AppendTabName "tg_append_tab_name")  (QS-IncludeModelSpaceTab "tg_include_model_space_tab")))
  ; rd = reset data (val1 val2 ...) , in case of a cancel store original values before start of dialog
  (if (null MainDialog-rd) (setq MainDialog-rd (Save_Dialog_Data MainDialog-tl)))
  ; set edit boxes and toggle values
  (Set_Dialog_Tiles MainDialog-tl)
  ; set popup list defaults (if trying vla-saveas use dwg-version-list / dxf-version-list (see qs_init_variables)
  (start_list "pl_dwg_version")(mapcar 'add_list dwg-version-list)(end_list)(set_tile "pl_dwg_version" QS-DwgAutocadVersion)
  (start_list "pl_dxf_version")(mapcar 'add_list dxf-version-list)(end_list)(set_tile "pl_dxf_version" QS-DxfAutocadVersion)
  (start_list "pl_dwg_folder_type")(mapcar 'add_list folder-type-list)(end_list)(set_tile "pl_dwg_folder_type" QS-DwgFolderType)
  (start_list "pl_dxf_folder_type")(mapcar 'add_list folder-type-list)(end_list)(set_tile "pl_dxf_folder_type" QS-DxfFolderType)
  (start_list "pl_pdf_folder_type")(mapcar 'add_list folder-type-list)(end_list)(set_tile "pl_pdf_folder_type" QS-PdfFolderType)
  ; show status current drawing
  (set_tile "tp_status" (strcat "     Current dwg : " org-dwg-path org-dwg-name " (" org-dwg-ver ")"))
  ; quickfix
  (if (and (not (void QS-LispFileNameToChangeFolderString))(findfile QS-LispFileNameToChangeFolderString))
    (set_tile "eb_lisp_filename_to_change_folder_string" (vl-filename-base QS-LispFileNameToChangeFolderString)))
)

(defun init_dialog_actions ()
  (mapcar '(lambda (x)(action_tile (car x) (cadr x)))
          '(;buttons
            ("cancel" "(done_dialog 0)") ("accept" "(done_dialog 1)")
            ("bt_select_backup_folder" "(Select_Backup_Folder)")
            ("bt_pdf_options" "(begin_pdf_options_dialog)")
            ("bt_select_lispfile_to_change_folder_string" "(select_lisp_file)")
           
            ; edit boxes & toggles
            ("eb_backup_folder" "(setq QS-BackupFolderName $value)")
            ("eb_sub_folder" "(setq QS-SubFolderName $value)")
            ("eb_old_folder_string" "(setq QS-OldFolderString $value)")
            ("eb_new_folder_string" "(setq QS-NewFolderString $value)")
            ("tg_use_lispfile_to_change_folder_string" "(setq QS-UseLispFileToChangeFolderString $value)")
            ("eb_lisp_filename_to_change_folder_string" "(setq QS-LispFileNameToChangeFolderString $value)")
           
            ("tg_create_dwg" "(setq QS-CreateDwg $value)")
            ("tg_create_dxf" "(setq QS-CreateDxf $value)")
            ("tg_create_pdf" "(setq QS-CreatePdf $value)")
           
            ("tg_zoom_extents" "(setq QS-ZoomExtents $value)")
            ("tg_purge_all" "(setq QS-PurgeAll $value)")
            ("tg_save_all_tabs" "(setq QS-SaveAllTabs $value)")
            ("tg_append_tab_name" "(setq QS-AppendTabName $value)")
            ("tg_include_model_space_tab" "(setq QS-IncludeModelSpaceTab $value)")
            ("tg_audit" "(setq QS-Audit $value)")

            ; popup lists
            ("pl_dwg_version" "(setq QS-DwgAutocadVersion $value)")
            ("pl_dxf_version" "(setq QS-DxfAutocadVersion $value)")
            ("pl_dwg_folder_type" "(setq QS-DwgFolderType $value)")
            ("pl_dxf_folder_type" "(setq QS-DxfFolderType $value)")
            ("pl_pdf_folder_type" "(setq QS-PdfFolderType $value)")
  
  )
 )
)

(defun Main_dialog_cancel () (Reset_Dialog_Data MainDialog-tl MainDialog-rd) (WriteSettingsToRegistry))
(defun Save_Dialog_Data (%tl) (mapcar '(lambda (x) (eval (car x))) %tl))
(defun Reset_Dialog_Data (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd))
(defun Set_Dialog_Tiles (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl))

(defun Select_Backup_Folder ( / fn )
  (if (setq fn (GetFolder "Select Backup Folder")) (set_tile "eb_backup_folder" (setq QS-BackupFolderName fn))))

(defun GetFolder ( msg / fl sh)
  (if (and (setq sh (vlax-create-object "Shell.Application")) (setq fl (vlax-invoke sh 'browseforfolder 0 msg 0 "")))
    (setq fl (vlax-get-property (vlax-get-property fl 'self) 'path))(setq fl nil))(release_me (list sh)) fl)

(defun Select_Lisp_File ( / fn)
  (if (setq fn (getfiled "Select Lisp File" "" "lsp" 0))
    (set_tile "eb_lisp_filename_to_change_folder_string" (vl-filename-base (setq QS-LispFileNameToChangeFolderString fn)))))
      

(defun run_qs ( / fn)
  (if (/= (getvar "DWGTITLED") 1)
    (princ "\nDrawing hasn't have a name yet")
    (progn
      (if (= QS-Audit "1")(vla-AuditInfo actDoc :vlax-true))
      (if (= QS-PurgeAll "1") (vla-purgeall actDoc))
      (if (= QS-ZoomExtents "1")(vla-ZoomExtents acApp))
      (if (= QS-CreatePdf "1")(create_pdf))
      (if (= QS-CreateDxf "1")(create_dxf))
      (if (= QS-CreateDwg "1")(create_dwg))
    )
  )
  (princ)
)


;--- + + + --------------------------------------------- Begin of tiny lisp section --------------------------------------------- + + + ---

(defun get_versions ( / v) (setq v (atoi (getvar 'acadver)))(mapcar 'cdr (vl-remove-if '(lambda (x)(> (car x) v))
 '((12 . "R12")(15 . "2000")(16 . "2004")(17 . "2007")(18 . "2010")(19 . "2013")(22 . "2018")(23 . "2020")))))

(defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x))))))

(defun string-p (s)(if (= (type s) 'str) t nil))

(defun release_me (l) (mapcar '(lambda (x)
  (if (and (= 'vla-object (type x))(not (vlax-object-released-p x)))(vlax-release-object x))(set (quote x) nil)) l))

(defun chgtxt (n o s / i l)
  (setq l (strlen n) i 0) (while (setq i (vl-string-search o s i)) (setq s (vl-string-subst n o s i) i (+ i l))) s)

(defun create_folder ( fol / _mf _sf sf)
  (defun _mf (rt sf)(if sf ((lambda (fol)(vl-mkdir fol)(_mf fol (cdr sf)))(strcat rt "\\" (car sf)))))
   (defun _sf ( f / i)(if (setq i (vl-string-search "\\" f))(cons (substr f 1 i)(_sf (substr f (+ i 1 (strlen "\\")))))(list f)))
    (if (setq sf (_sf (vl-string-translate "/" "\\" fol))) (_mf (car sf) (cdr sf))) (if (vl-file-directory-p fol) fol nil))

(defun backup ( s d / scr err)
  (if (and (string-p s) (string-p d) (setq s (findfile s)) (setq scr (vlax-create-object "scripting.filesystemobject")))
    (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-invoke (list scr 'copyfile s d :vlax-false))))
      (prompt (vl-catch-all-error-message err)) (progn (vlax-release-object scr) T)) nil))

(defun dwgver (/ dwg fp dv av)
  (setq dwg (strcat (getvar "dwgprefix")(getvar "dwgname")) fp (open dwg "r") dv (substr (read-line fp) 1 6))(close fp)
  (cond ((= (substr dv 1 5) "MC0.0")(setq av "AutoCAD R1.0"))  ((= (substr dv 1 5) "AC1.2")(setq av "AutoCAD R1.2"))
        ((= dv "AC1.40")(setq av "AutoCAD R1.40"))             ((= dv "AC1.50")(setq av "AutoCAD R2.05"))
        ((= dv "AC2.10")(setq av "AutoCAD R2.10"))             ((= dv "AC2.21")(setq av "AutoCAD R2.21"))
        ((= dv "AC2.22")(setq av "AutoCAD R2.22"))             ((= dv "AC1001")(setq av "AutoCAD R2.22"))
        ((= dv "AC1002")(setq av "AutoCAD R2.50"))             ((= dv "AC1003")(setq av "AutoCAD R2.60"))
        ((= dv "AC1004")(setq av "AutoCAD R9"))                ((= dv "AC1006")(setq av "AutoCAD R10"))
        ((= dv "AC1009")(setq av "AutoCAD R11-R12"))           ((= dv "AC1012")(setq av "AutoCAD R13"))
        ((= dv "AC1014")(setq av "AutoCAD R14"))               ((= dv "AC1015")(setq av "AutoCAD 2000(i)-2002"))
        ((= dv "AC1018")(setq av "AutoCAD 2004-2006"))         ((= dv "AC1021")(setq av "AutoCAD 2007-2009"))
        ((= dv "AC1024")(setq av "AutoCAD 2010-2012"))         ((= dv "AC1027")(setq av "AutoCAD 2013-2017"))
        ((= dv "AC1032")(setq av "AutoCAD 2018-2020"))         (t (setq av "AutoCAD R.???"))) av )

(defun init_version_lists ( / l1 l2)
  (setq l1 '(acR12_dxf acR14_dwg ac2000_dwg ac2000_dxf ac2000_Template ac2004_dwg ac2004_dxf ac2004_Template
             ac2007_dwg ac2007_dxf ac2007_Template ac2010_dwg ac2010_dxf ac2010_Template ac2013_dwg ac2013_dxf
             ac2013_Template ac2018_dwg ac2018_dxf ac2018_Template acNative)
        l2 (vl-remove-if '(lambda(x)(not (eval x))) l1)
        dwg-version-list (vl-remove-if '(lambda (x)(not (wcmatch x "*_dwg"))) (mapcar 'vl-symbol-name l2))
        dxf-version-list (vl-remove-if '(lambda (x)(not (wcmatch x "*_dxf"))) (mapcar 'vl-symbol-name l2))))

; current dwg versions : ("R12" "2000" "2004" "2007" "2010" "2013" "2018")
(defun version_to_string ( v / s )
  (if (setq s (assoc v ' (("acR12_dxf" . "R12")("acR14_dwg" . "R12")("ac2000_dwg" . "2000")("ac2000_dxf" . "2000")
   ("ac2004_dwg" . "2004")("ac2004_dxf" . "2004")("ac2007_dwg" . "2007")("ac2007_dxf" . "2007")("ac2010_dwg" . "2010")
   ("ac2010_dxf" . "2010")("ac2013_dwg" . "2013")("ac2013_dxf" . "2013")("ac2018_dwg" . "2018")("ac2018_dxf" . "2018"))))(cdr s) ""))
 

; some extra info on saveas types :
; (getenv "DefaultFormatForSave") (setenv "DefaultFormatForSave" "YourValue")
; (vla-put-SaveAsType (vla-get-OpenSave (vla-get-Preferences (vlax-get-acad-Object))) ac2010_dwg)
; (vla-get-SaveAsType (vla-get-OpenSave (vla-get-Preferences (vlax-get-acad-Object))))

; (SplitPath "c:/temp/;d:/test") -> "c:/temp/"
(defun SplitPath ($p / l) (if (wcmatch $p "*;*")(car (splitstr $p ";")) $p))

; (fixpath "c:/temp/test") -> "c:\\temp\\test\\"
(defun FixPath ($p)(strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\"))

; (SplitStr "a,b" ",") -> ("a" "b")
(defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s)))

; choose from list (cfl '("1""2""3"))
(defun cfl (l / f p d r)
  (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
       (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p)
       (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)
       (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)")
         (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)")
         (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil)))


(defun put_plot_style (s)
  (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (vla-put-stylesheet x s)))

(defun put_paper_size (s)
  (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (vla-put-canonicalmedianame x s)))

(defun put_pdf_printer ()
  (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (vla-put-configname x "DWG To PDF.pc3")))

;--- + + + ---------------------------------------------- End of tiny lisp section ---------------------------------------------- + + + ---

(defun get_or_create_backup_folder ()
  (cond ((void QS-BackupFolderName) nil) ((vl-file-directory-p QS-BackupFolderName) QS-BackupFolderName)
    (t (create_folder QS-BackupFolderName) (if (vl-file-directory-p QS-BackupFolderName) QS-BackupFolderName nil))))

(defun get_or_create_sub_folder ( / fol)
  (cond ((void QS-SubFolderName) nil)((vl-file-directory-p (setq fol (strcat org-dwg-path QS-SubFolderName))) fol)
    (t (create_folder fol) (if (vl-file-directory-p fol) fol nil))))

(defun get_or_create_changed_folder ( / fol)
  (cond ((and (= QS-UseLispFileToChangeFolderString "0") (or (void QS-OldFolderString) (void QS-NewFolderString))))
        ((and (= QS-UseLispFileToChangeFolderString "1") (not (void QS-LispFileNameToChangeFolderString))
              (string-p QS-LispFileNameToChangeFolderString)(findfile QS-LispFileNameToChangeFolderString))
         (load (findfile QS-LispFileNameToChangeFolderString))
         (setq fol (eval (read (strcat "(" (vl-filename-base QS-LispFileNameToChangeFolderString) " '" org-dwg-path ")"))))
        )
        (t (setq fol (chgtxt QS-NewFolderString QS-OldFolderString org-dwg-path))
         (if (not (vl-file-directory-p fol))(create_folder fol))))
  (if (and (eq (type fol) 'STR) (not (vl-file-directory-p fol)))(create_folder fol))
  (if (and (eq (type fol) 'STR) (vl-file-directory-p fol)) fol org-dwg-path)
)

; dwg versions : ("R12" "2000" "2004" "2007" "2010" "2013" "2018")
; folder types : ("Backup Folder" "Current Folder" "Sub Folder" "Changed Folder")
(defun create_dwg ( / new-path fn err new-ver cmd)
  (cond
    ((= QS-DwgFolderType "0")(setq new-path (get_or_create_backup_folder)))
    ((= QS-DwgFolderType "1")(setq new-path org-dwg-path))
    ((= QS-DwgFolderType "2")(setq new-path (get_or_create_sub_folder)))
    (t (setq new-path (get_or_create_changed_folder)))
  )
 
  (if (findfile (setq fn (strcat (FixPath new-path) org-dwg-name)))(vl-file-delete fn))
  (setq new-ver (version_to_string (nth (atoi QS-DwgAutocadVersion) dwg-version-list)))

  (cond
    ; if version types are the same simple copy function is enough
    ((eq new-ver org-save-as-type)
     (if (> (getvar 'dbmod) 0) (vla-save actDoc)) (backup (strcat org-dwg-path org-dwg-name) fn))
    ; save in other version
    (t (setvar 'filedia 0)
     (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vl-cmdf (list ".saveas" new-ver fn))))
       (prompt (vl-catch-all-error-message err))) (setvar 'filedia 1)
     ; save it back , potential problem if newer version contains objects not supported by older AutoCad version?
     (vla-put-SaveAsType (vla-get-OpenSave (vla-get-Preferences (vlax-get-acad-Object))) org-save-as-type)
     (vla-SaveAs actDoc (strcat (FixPath org-dwg-path) org-dwg-name) org-save-as-type)
    )
  )
)

(defun create_dxf ( / new-path fn cmd err dxf-ver)
  (cond
    ((= QS-DxfFolderType "0")(setq new-path (get_or_create_backup_folder)))
    ((= QS-DxfFolderType "1")(setq new-path (getvar 'dwgprefix)))
    ((= QS-DxfFolderType "2")(setq new-path (get_or_create_sub_folder)))
    (t (setq new-path (get_or_create_changed_folder)))
  )

  (if (findfile (setq fn (strcat (FixPath new-path) (vl-filename-base (getvar 'dwgname)) ".dxf")))
    (vl-file-delete fn))
  (setq dxf-ver (version_to_string (nth (atoi QS-DxfAutocadVersion) dxf-version-list))
        cmd (list "dxfout" fn "version" dxf-ver 16))
  (setvar 'filedia 0)
  (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vl-cmdf cmd)))
    (prompt (vl-catch-all-error-message err)))
  (setvar 'filedia 1)
)

(defun create_pdf ( / fol i l ll ar rtn)
  (cond
    ((= QS-PdfFolderType "0")(setq fol (get_or_create_backup_folder)))
    ((= QS-PdfFolderType "1")(setq fol (getvar 'dwgprefix)))
    ((= QS-PdfFolderType "2")(setq fol (get_or_create_sub_folder)))
    (t (setq fol (get_or_create_changed_folder))))
  (if (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'put_plot_style (list QS-PdF-PlotStyle))))
    (prompt (strcat "\nError applying stylesheet : " (vl-catch-all-error-message rtn))))
  (if (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'put_paper_size (list QS-PdF-PaperSize))))
    (prompt (strcat "\nError applying paper size : " (vl-catch-all-error-message rtn))))
  (if (= QS-SaveAllTabs "1")
    (progn (vlax-for l (vla-get-Layouts actDoc)(setq ll (cons (vla-get-Name l) ll)))
           (if (/= QS-IncludeModelSpaceTab "1") (setq ll (vl-remove "Model" ll))))  (setq ll '("Model"))  )
  (setq i 0 ar (vlax-make-safearray vlax-vbString (cons 0 (1- (length ll)))))
  (foreach l ll (vlax-safearray-put-element ar i l)(setq i (1+ i)))
  (if (= QS-SaveAllTabs "1") (vla-SetLayoutsToPlot (vla-get-Plot actDoc) ar))
  ; this allways plots to current folder
  (vla-PlotToDevice (vla-get-Plot actDoc) "DWG To PDF.pc3")
  ; one solution would be to move pdf's to taget folder (only when not selected 'current folder')
  (if (/= QS-PdfFolderType "1")(move_pdfs ll fol))
)

; %l = list with layout names %f is taget folder
(defun move_pdfs (%l %f / cf cd old-pdf-names new-pdf-names)
  (setq cf (getvar 'dwgprefix) cd (vl-filename-base (getvar 'dwgname)))
  (setq old-pdf-names (mapcar '(lambda (x)(strcat (FixPath cf) cd "-" x ".pdf")) %l))
  (setq new-pdf-names (mapcar '(lambda (x)(strcat (FixPath %f) cd "-" x ".pdf")) %l))
  (gc)(mapcar '(lambda (x y) (vl-catch-all-apply 'vl-file-copy (list x y))) old-pdf-names new-pdf-names)
  (gc)(mapcar '(lambda ( x ) (vl-catch-all-apply 'vl-file-delete (list x))) old-pdf-names)
)

;--- PdF ------------------------------------------------- Begin of PdF section --------------------------------------------------- PdF ---

(defun begin_pdf_options_dialog ( / drv old-paper old-style)
  (setq old-paper QS-PdF-PaperSize old-style QS-PdF-PlotStyle)
  (if (and dialog-id (new_dialog "pdf_options" dialog-id))
    (progn
      (action_tile "cancel" "(done_dialog 0)")
        (action_tile "accept" "(done_dialog 1)")
      (set_tile "eb_pdf_paper_size" (if (string-p QS-PdF-PaperSize) QS-PdF-PaperSize "- njet set yet - "))
       (action_tile "eb_pdf_paper_size" "(setq QS-PdF-PaperSize $value)")
        (action_tile "bt_pdf_paper_size" "(select_pdf_paper_size)")
      (set_tile "eb_pdf_plot_style" (if (string-p QS-PdF-PlotStyle) QS-PdF-PlotStyle "- njet set yet - "))
       (action_tile "eb_pdf_plot_style" "(setq QS-PdF-PlotStyle $value)")
        (action_tile "bt_pdf_plot_style" "(select_pdf_plot_style)")
      (setq drv (start_dialog))
      (cond
        ((= drv 0)(setq QS-PdF-PaperSize old-paper QS-PdF-PlotStyle old-style))
        ((= drv 1)(WriteSettingsToRegistry)) (t (princ "\nOh darn...")))
    )
  )
)

(defun select_pdf_paper_size ( / rtn) (if (setq rtn (cfl (GetPaperSizes))) (set_tile "eb_pdf_paper_size" (setq QS-PdF-PaperSize rtn))))
(defun select_pdf_plot_style ( / rtn) (if (setq rtn (cfl (GetPlotStyles))) (set_tile "eb_pdf_plot_style" (setq QS-PdF-PlotStyle rtn))))


;--- PdF -------------------------------------------------- End of PdF section ---------------------------------------------------- PdF ---

; example for a custom change path routine : ChangeMyPath.lsp
; test : (ChangeMyPath 'P:\\MM18661_FCP\\1600\E\\) , (ChangeMyPath 'P:/MM18661_FCP/1600/E/) or (ChangeMyPath "P:/MM18661_FCP/1600/E/")

(defun ChangeMyPath (old-path / new-path)
  (setq old-path (vl-princ-to-string old-path))
  (cond
    ((wcmatch (strcase old-path) "*1600*")
     (setq new-path (vl-string-subst "Flexible Compounding Plant" "1600" old-path)))
    ((wcmatch (strcase old-path) "*1400*")
     (setq new-path (vl-string-subst "Chlorine Plant" "1400" old-path)))
    ((wcmatch (strcase old-path) "*0100*")
     (setq new-path (vl-string-subst "Utilities" "0100" old-path)))
    (t (setq new-path old-path))
  )
  new-path
)

(princ "\nRLX 10 may 2019 - use QS for saving, use QSS for quick save setup")
(princ)

Edited May 10, 2019 by rlx

May 10, 2019

On 4/23/2019 at 1:36 PM, rlx said:

you could use a double save-as , where the first would save as 2013 in the parallel folder and the second saveas 2018 back in the original folder.

Or you could just execute a normal QSAVE, the execute the SAVE command, which will write the drawing to a different location, but not take you there. You will remain in the same drawing.

May 10, 2019

I use a command reactor to make backups of my drawings in 15 minute increments on my C drive .. I'll post what I have in a bit.

May 10, 2019

RLX,

I am not worthy man, loaded your program and tested it.... to say the least, I am blown away! Thank you for helping me out!!! I think this will work out for us, I need to play with it some, but I am super impressed!

Thanks a ton!!

Dustin

May 10, 2019

Not nearly as fancy as @rlx 's code but has served me well for many years.

(defun rjp-backupdwg (/ _date bd copyp d date dcp dp dwgp h m)
  ;; RJP » 2019-05-10
  (defun _date (f) (menucmd (strcat "M=$(edtime,$(getvar,date)," f ")")))
  (cond	((and (= 1 (getvar 'dwgtitled) (getvar 'writestat))
	      (or (vl-file-directory-p (setq bd (strcat (getenv "homedrive") "/AutoCAD-BAK/")))
		  (vl-mkdir bd)
	      )
	 )
	 (setq dp    (getvar 'dwgprefix)
	       date  (_date "YYYY.MO.DD/")     
	       m     (itoa (abs (- (rem  (setq m (atoi (_date "MM"))) 15) m)))
	       h     (strcat (_date "HH") "-" (if (= m "0") "0" "") m "/")
	       dcp   (strcat (vl-string-right-trim "." (substr (vl-string-translate "\\\"" "." dp) 4)) "/")
	       copyp (strcat bd date h dcp (getvar 'dwgname))
	       dwgp  (strcat dp (getvar 'dwgname))
	 )
	 (vl-mkdir (setq d (strcat bd date)))
	 (vl-mkdir (setq d (strcat d h)))
	 (vl-mkdir (setq d (strcat d dcp)))
	 (and (findfile copyp) (vl-file-delete copyp))
	 (and (vl-file-directory-p d) (vl-file-copy dwgp copyp))
	)
  )
  (princ)
)
(or *rjp-commandreactors*
    (setq *rjp-commandreactors* (vlr-command-reactor nil '((:vlr-commandended . endcmd))))
)
(defun endcmd (calling-reactor endcmdinfo)
  (and (wcmatch (car endcmdinfo) "*SAVE*") (rjp-backupdwg))
)
;; Format that drawing is saved in 15 minute increment subfolders
;; C:\AutoCAD-BAK\DATE\TIME\Path.of.drawing\drawingname.dwg

Edited May 10, 2019 by ronjonp
*fixed an error

May 10, 2019

55 minutes ago, dustinalbaugh said:

RLX,

I am not worthy man, loaded your program and tested it.... to say the least, I am blown away! Thank you for helping me out!!! I think this will work out for us, I need to play with it some, but I am super impressed!

Thanks a ton!!

Dustin

If locations are fixed all of the dialog stuf wouldn't matter , but just wanted it to look sexy and easy adjustable . But if some of the code can be done better... I'm all ears.

The normal save command doesn't let you switch between versions. If versions are the same and you only need the file saved at a double location the program uses file copy automatically . Did test to use vla-saveas twice but at one pc it worked and on another the original file stayed locked and I couldn't switch back. Don't no if it was bad coding or an AutoCad quirk or bug but couln't take the risk so thats why I decided to use the normal saveas command for that.

The list with versions is dynamic and will show only the versions that are valid for your AutoCad version.

Gonna field test it next week and see if it does everything it's suppost to do

have a nice weekend

May 10, 2019

14 minutes ago, ronjonp said:

Not nearly as fancy as @rlx 's code but has served me well for many years.

If it works for you Ronjonp , you should keep it . I probably will never have to save to two different versions myself but if I would have the need , why not make it easier for more people

But now I see your code , adding automatic save option might be a nice option to, thanx for sharing

gr. RLX

May 10, 2019

49 minutes ago, rlx said:

The normal save command doesn't let you switch between versions.

That's weird. The dialog version does, but the command line version doesn't.

May 10, 2019

11 minutes ago, rkmcswain said:

That's weird. The dialog version does, but the command line version doesn't.

I suppose when you don't switch versions the dialog uses save and but when you do it uses saveas. But that's the fun part about AutoCad , even after many years you still discover new things

May 10, 2019

Thanks guys, you all rock! I am just scratching the surface with lisping but I clearly see I need to dig my teeth in and learn more. There is so much I could build for my firm if I had the knowledge! Not to mention help other novices on here like myself! Lol ! Thank you guys!!!

Dustin

Save a copy of a Dwg file to two locations

Recommended Posts

dustinalbaugh

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

rlx

Link to comment

Share on other sites

rkmcswain

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

dustinalbaugh

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

rlx

Link to comment

Share on other sites

rlx

Link to comment

Share on other sites

rkmcswain

Link to comment

Share on other sites

rlx

Link to comment

Share on other sites

dustinalbaugh

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity