SAVEALL, CLOSEALL, Zoom Extents all open drawings

[ryankevin15]

.

Edited December 31, 2018 by ryankevin15

[BIGAL]

Your order is not quite right 

 

Zoom E mspace

Zoom e layouts and lock viewports

Close Y

next dwg.

 

I know in Objectdbx you can get a list of all open dwgs it may then be as simple as writing a script to do the steps making sure the last DWG is the one you start the script in. Not something I would do normally.

 

; something like

(setq acDocs (vla-get-documents (vlax-get-acad-object)))
(vla-activate (vla-item acdocs 1))

Edited October 3, 2018 by BIGAL

[mostafa badran]

Maybe this help only for single file, you can use it for multi file by using AutoScript

(defun lockallvport (/ lay ent)
  (vlax-for lay
		(vla-get-layouts
		  (vla-get-activedocument (vlax-get-acad-object))
		)
    (if	(eq :vlax-false (vla-get-modeltype lay))
      (vlax-for	ent (vla-get-block lay)
	(if (= (vla-get-objectname ent) "AcDbViewport")
	  (vla-put-displaylocked ent :vlax-true)
	)
      )
    )
  )
  (princ)
)

(defun ZoomextentLayouts (/)
  ;; Zoom extents in All Layouts (excluding Model)
  ;; Alan J. Thompson, 12.23.10
  (or *Acad* (setq *Acad* (vlax-get-acad-object)))
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument *Acad*)))
  ((lambda (ctab)
     (foreach layout (layoutlist)
       (setvar 'ctab layout)
       (vla-put-mspace *AcadDoc* :vlax-false)
       (vla-zoomextents *Acad*)
     )
     (setvar 'ctab ctab)
   )
    (getvar 'ctab)
  )
  (princ)
)
(defun c:cdwg (/)
  (vl-load-com)
  (ZoomextentLayouts)
  (lockallvport)
  (command "qsave" "close")
  (princ)
)

 

[BIGAL]

A script is one way to do it like mostafa run a lisp that has the two steps the 1st is run the acdocs to find out how many DWG's are open use a repeat to write the script, I could be wrong  but the script needs to run the two lines in each dwg to redo the acdocs variable item 0 is the 1st dwg so if 1 only will still work.

 

(setq acDocs (vla-get-documents (vlax-get-acad-object)))
(setq numDocs (vla-get-count acdocs))

open a script file here fo 

(Repeat numdocs

(write-line "(setq acDocs (vla-get-documents (vlax-get-acad-object)))" fo)

(write-line "(vla-activate (vla-item acdocs 0))" fo)
(write-line "(load "locklaysetc")" fo)

(write-line "close y" fo)

)

(close fo)

(command "script" yourscriptname)

[rlx]

relatively quickly written (lite version from my RlxBatch application) , appie to run a script over all open drawings. Hope its self explanatory enough and bug free cause haven't got the time right now to do much testing (nor do I need the lite version when I have his big brother of course)

(vl-load-com)

(defun c:RlxScriptOpenDrawings ( / app docs open-docs dcl-fn dcl-fp dcl-id save-dwg reopen-dwg
                                   mister-slave slave-fp master master-fp run-scr)
 
  (setq app (vlax-get-acad-object) docs (vla-get-documents app))
  (vlax-for doc docs
    ; no nameless drawings
    (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED")))
      (setq open-docs (cons (cons (vla-get-fullname doc) doc) open-docs))))
  (RlxScriptOpenDrawings_Dialog_Start)
  (RlxScriptOpenDrawings_Exit)
  (if run-scr (command "_.script" master))
)

(defun RlxScriptOpenDrawings_Exit ()
  (if (and dcl-fn (findfile dcl-fn))(vl-file-delete (findfile dcl-fn))))

(defun _CloseAllButCurrent (/ dwg )
  (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))
    (if (= (vla-get-Active dwg) :vlax-False)
      (if (= (vla-get-ReadOnly dwg) :vlax-true)
 (vla-close dwg :vlax-False)
 (vl-catch-all-apply
          (function
            (lambda ()
              (if (/= (getvar "dwgtitled") 0) (vla-save dwg))(vla-close dwg :vlax-False))))
      )
    )
  )
)

(defun _quit_all ( / dwg)
 (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))
   (if (= (vla-get-active dwg) :vlax-false)(vla-close dwg :vlax-false)))
 (command-s "._close" "_y")
)

(defun _close_all ( / dwg )
  (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))(vla-close dwg :vlax-True)))

; start with empty drawing and close the rest
(defun MDI_Scr_Init ()
  (eval "(setvar \"filedia\" 0)\n.new\n\n(load\"RlxScriptOpenDrawings\")\n(_CloseAllButCurrent)"))
; I say yeah yeah
(defun MDI_Scr_Open ($fn)
  (strcat ".open\n" $fn "\n(while (= 1 (logand (getvar \"cmdactive\") 1))(command \"Yes\"))"))

; To save or not to save
(defun MDI_Scr_Close ()
  (if (eq save-dwg "1")
    (eval "(if (= (getvar \"writestat\") 1)(command \".qsave\" \".close\"))")
    (eval "(if (> (getvar \"dbmod\") 0) (command \".close\" \"no\")(command \".close\"))")
  )
)

(defun RlxScriptOpenDrawings_Write_MDI_Script ( / master-fp slave-commands)
  (cond
    ; debugging services :
    ; with proven reliabilty this can of course be one big giant 'and-function
    ((not (vl-consp open-docs)) (alert "No (named) open drawings"))
    ((or (null mister-slave) (and (= (type mister-slave) 'STR)(eq mister-slave "")))
     (alert "Invalid script file name"))
    ((not (findfile mister-slave))
     (alert (strcat "Unable to find script file : \n" mister-slave)))
    ((not (setq slave-fp (open mister-slave "r")))
     (alert "Unable to read from slave script file"))
    ((not (vl-consp (setq slave-commands (_GetSlaveCommands slave-fp))))
     (alert "No commands where found in slave script file"))
    ((not (setq master (vl-filename-mktemp "rlxscript" (getvar 'MYDOCUMENTSPREFIX) ".scr")))
     (alert "Unable to create master script file"))
    ((not (setq master-fp (open master "w")))
     (alert "Unable to write to master script file"))
    (t
     (write-line (MDI_Scr_Init) master-fp)
     (mapcar
       '(lambda (x)
          ; load the patient
          (write-line (MDI_Scr_Open x) master-fp)
          ; write all commands from slave script
   (mapcar '(lambda (cmd) (write-line cmd master-fp)) slave-commands)
   ; dump the patient
   (write-line (MDI_Scr_Close) master-fp)
        )
 (mapcar 'car open-docs)
      )
     ; if drawings must be reopened
     (if (eq reopen-dwg "1")
       (mapcar '(lambda (x)(write-line (strcat ".open " x) master-fp)) (mapcar 'car open-docs)))
    )
  )
  (if master-fp (progn (close master-fp)(gc)(setq RlxBatch-RunScriptOnExit t)))
)

(defun _GetSlaveCommands ( fp / i l)
  (if fp (while (setq i (read-line fp))(setq l (cons i l))))(if fp (close fp))(if l (reverse l) nil))

(defun RlxScriptOpenDrawings_Dialog_Create ()
  (if (and (setq dcl-fn (vl-filename-mktemp ".dcl")) (setq dcl-fp (open dcl-fn "w")))
    (mapcar '(lambda (x)(write-line x dcl-fp))
     '("ScriptOpenDrawings :dialog {label=\"Script Open Drawings (RLX 10/'18)\";"
               ":boxed_row {label=\"Script name\";"
                   ":column {:edit_box {key=\"eb_script_name\";}"
                            ":row {:button {label=\"Open\";key=\"bt_open_script_file\";fixed_width=true;}"
                                  ":button {label=\"Create\";key=\"bt_create_script_file\";fixed_width=true;}"
                                  ":button {label=\"Edit\";key=\"bt_edit_script_file\";fixed_width=true;}}}}"
                "spacer;:row {spacer;:toggle {label=\" Save \";key=\"tg_save_drawing\";}"
                                    ":toggle {label=\"Reopen\";key=\"tg_reopen_drawing\";}}spacer;ok_cancel;}")))
  (if dcl-fp (close dcl-fp))(gc)
)

(defun RlxScriptOpenDrawings_Dialog_Action ()
  (mapcar '(lambda (x)(action_tile (car x) (last x)))
   '(("cancel" "(done_dialog 0)") ("accept" "(done_dialog 1)")
            ("eb_script_name" "(setq mister-slave $value)") ("bt_open_script_file" "(open_scriptfile)")
            ("bt_create_script_file" "(create_scriptfile)") ("bt_edit_script_file" "(edit_scriptfile)")
            ("tg_save_drawing" "(setq save-dwg $value)") ("tg_reopen_drawing" "(setq reopen-dwg $value)"))
  )
)

(defun RlxScriptOpenDrawings_Dialog_Start ( / drv vl tl dd rd )
  (if (null dcl-fn)(RlxScriptOpenDrawings_Dialog_Create))
  (if (and (setq dcl-id (load_dialog dcl-fn)) (new_dialog "ScriptOpenDrawings" dcl-id))
    (progn
      (RlxScriptOpenDrawings_Dialog_Action)
      (setq drv (start_dialog))
      (unload_dialog dcl-id)
      (cond
 ((= drv  0))
 ((= drv  1)(go_script_yourself))
      )
    )
  )
)

(defun go_script_yourself ()
  (RlxScriptOpenDrawings_Write_MDI_Script)
  (setq run-scr t)
)

(defun open_scriptfile ( / fn)
  (if (setq fn (getfiled "Open script file" "" "scr" 0))
    (set_tile "eb_script_name" (setq mister-slave fn)))
)
           
(defun create_scriptfile ( / fn fp)
  (if (and (setq fn (getfiled "Create script file" "" "scr" 1)) (setq fp (open fn "w")))
    (progn (close fp)(gc)(set_tile "eb_script_name" (setq mister-slave fn))))
)

(defun edit_scriptfile ()
  (if (and mister-slave (= (type mister-slave) 'STR) (findfile mister-slave))
    (progn (startapp "notepad" mister-slave))))

[ryankevin15]

6 hours ago, rlx said:

relatively quickly written (lite version from my RlxBatch application) , appie to run a script over all open drawings. Hope its self explanatory enough and bug free cause haven't got the time right now to do much testing (nor do I need the lite version when I have his big brother of course)

 

(vl-load-com)

(defun c:RlxScriptOpenDrawings ( / app docs open-docs dcl-fn dcl-fp dcl-id save-dwg reopen-dwg
                                   mister-slave slave-fp master master-fp run-scr)
 
  (setq app (vlax-get-acad-object) docs (vla-get-documents app))
  (vlax-for doc docs
    ; no nameless drawings
    (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED")))
      (setq open-docs (cons (cons (vla-get-fullname doc) doc) open-docs))))
  (RlxScriptOpenDrawings_Dialog_Start)
  (RlxScriptOpenDrawings_Exit)
  (if run-scr (command "_.script" master))
)

(defun RlxScriptOpenDrawings_Exit ()
  (if (and dcl-fn (findfile dcl-fn))(vl-file-delete (findfile dcl-fn))))

(defun _CloseAllButCurrent (/ dwg )
  (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))
    (if (= (vla-get-Active dwg) :vlax-False)
      (if (= (vla-get-ReadOnly dwg) :vlax-true)
 (vla-close dwg :vlax-False)
 (vl-catch-all-apply
          (function
            (lambda ()
              (if (/= (getvar "dwgtitled") 0) (vla-save dwg))(vla-close dwg :vlax-False))))
      )
    )
  )
)

(defun _quit_all ( / dwg)
 (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))
   (if (= (vla-get-active dwg) :vlax-false)(vla-close dwg :vlax-false)))
 (command-s "._close" "_y")
)

(defun _close_all ( / dwg )
  (vlax-for dwg (vla-get-Documents (vlax-get-acad-object))(vla-close dwg :vlax-True)))

; start with empty drawing and close the rest
(defun MDI_Scr_Init ()
  (eval "(setvar \"filedia\" 0)\n.new\n\n(load\"RlxScriptOpenDrawings\")\n(_CloseAllButCurrent)"))
; I say yeah yeah
(defun MDI_Scr_Open ($fn)
  (strcat ".open\n" $fn "\n(while (= 1 (logand (getvar \"cmdactive\") 1))(command \"Yes\"))"))

; To save or not to save
(defun MDI_Scr_Close ()
  (if (eq save-dwg "1")
    (eval "(if (= (getvar \"writestat\") 1)(command \".qsave\" \".close\"))")
    (eval "(if (> (getvar \"dbmod\") 0) (command \".close\" \"no\")(command \".close\"))")
  )
)

(defun RlxScriptOpenDrawings_Write_MDI_Script ( / master-fp slave-commands)
  (cond
    ; debugging services :
    ; with proven reliabilty this can of course be one big giant 'and-function
    ((not (vl-consp open-docs)) (alert "No (named) open drawings"))
    ((or (null mister-slave) (and (= (type mister-slave) 'STR)(eq mister-slave "")))
     (alert "Invalid script file name"))
    ((not (findfile mister-slave))
     (alert (strcat "Unable to find script file : \n" mister-slave)))
    ((not (setq slave-fp (open mister-slave "r")))
     (alert "Unable to read from slave script file"))
    ((not (vl-consp (setq slave-commands (_GetSlaveCommands slave-fp))))
     (alert "No commands where found in slave script file"))
    ((not (setq master (vl-filename-mktemp "rlxscript" (getvar 'MYDOCUMENTSPREFIX) ".scr")))
     (alert "Unable to create master script file"))
    ((not (setq master-fp (open master "w")))
     (alert "Unable to write to master script file"))
    (t
     (write-line (MDI_Scr_Init) master-fp)
     (mapcar
       '(lambda (x)
          ; load the patient
          (write-line (MDI_Scr_Open x) master-fp)
          ; write all commands from slave script
   (mapcar '(lambda (cmd) (write-line cmd master-fp)) slave-commands)
   ; dump the patient
   (write-line (MDI_Scr_Close) master-fp)
        )
 (mapcar 'car open-docs)
      )
     ; if drawings must be reopened
     (if (eq reopen-dwg "1")
       (mapcar '(lambda (x)(write-line (strcat ".open " x) master-fp)) (mapcar 'car open-docs)))
    )
  )
  (if master-fp (progn (close master-fp)(gc)(setq RlxBatch-RunScriptOnExit t)))
)

(defun _GetSlaveCommands ( fp / i l)
  (if fp (while (setq i (read-line fp))(setq l (cons i l))))(if fp (close fp))(if l (reverse l) nil))

(defun RlxScriptOpenDrawings_Dialog_Create ()
  (if (and (setq dcl-fn (vl-filename-mktemp ".dcl")) (setq dcl-fp (open dcl-fn "w")))
    (mapcar '(lambda (x)(write-line x dcl-fp))
     '("ScriptOpenDrawings :dialog {label=\"Script Open Drawings (RLX 10/'18)\";"
               ":boxed_row {label=\"Script name\";"
                   ":column {:edit_box {key=\"eb_script_name\";}"
                            ":row {:button {label=\"Open\";key=\"bt_open_script_file\";fixed_width=true;}"
                                  ":button {label=\"Create\";key=\"bt_create_script_file\";fixed_width=true;}"
                                  ":button {label=\"Edit\";key=\"bt_edit_script_file\";fixed_width=true;}}}}"
                "spacer;:row {spacer;:toggle {label=\" Save \";key=\"tg_save_drawing\";}"
                                    ":toggle {label=\"Reopen\";key=\"tg_reopen_drawing\";}}spacer;ok_cancel;}")))
  (if dcl-fp (close dcl-fp))(gc)
)

(defun RlxScriptOpenDrawings_Dialog_Action ()
  (mapcar '(lambda (x)(action_tile (car x) (last x)))
   '(("cancel" "(done_dialog 0)") ("accept" "(done_dialog 1)")
            ("eb_script_name" "(setq mister-slave $value)") ("bt_open_script_file" "(open_scriptfile)")
            ("bt_create_script_file" "(create_scriptfile)") ("bt_edit_script_file" "(edit_scriptfile)")
            ("tg_save_drawing" "(setq save-dwg $value)") ("tg_reopen_drawing" "(setq reopen-dwg $value)"))
  )
)

(defun RlxScriptOpenDrawings_Dialog_Start ( / drv vl tl dd rd )
  (if (null dcl-fn)(RlxScriptOpenDrawings_Dialog_Create))
  (if (and (setq dcl-id (load_dialog dcl-fn)) (new_dialog "ScriptOpenDrawings" dcl-id))
    (progn
      (RlxScriptOpenDrawings_Dialog_Action)
      (setq drv (start_dialog))
      (unload_dialog dcl-id)
      (cond
 ((= drv  0))
 ((= drv  1)(go_script_yourself))
      )
    )
  )
)

(defun go_script_yourself ()
  (RlxScriptOpenDrawings_Write_MDI_Script)
  (setq run-scr t)
)

(defun open_scriptfile ( / fn)
  (if (setq fn (getfiled "Open script file" "" "scr" 0))
    (set_tile "eb_script_name" (setq mister-slave fn)))
)
           
(defun create_scriptfile ( / fn fp)
  (if (and (setq fn (getfiled "Create script file" "" "scr" 1)) (setq fp (open fn "w")))
    (progn (close fp)(gc)(set_tile "eb_script_name" (setq mister-slave fn))))
)

(defun edit_scriptfile ()
  (if (and mister-slave (= (type mister-slave) 'STR) (findfile mister-slave))
    (progn (startapp "notepad" mister-slave))))


Some dialog box pops up when I run it. I just want it to save, zoom extents and close all open drawing files.

 

[BIGAL]

Maybe we are reading to much into this, a lisp called closemydwg is what is needed just autoload it, as it closes a dwg it will go to the next one, just type it again. The shorter typing use zzz as command name. Not that hard.

[rlx]

oh very well then

; zoom - lock - close
(defun c:zlc ( / d o s f c)
  (setq d (vla-get-documents (vlax-get-acad-object)) s (strcat (getvar 'MYDOCUMENTSPREFIX) "\\zlc.scr") f (open s "w")
        c "\n(while (= 1 (logand (getvar \"cmdactive\") 1))(command \"Yes\"))\n(load\"zlc\")\nzlv\n._qsave\n._close")
  (vlax-for x d (if (= 1 (vlax-variant-value (vla-getvariable x "DWGTITLED")))(setq o (cons (vla-get-fullname x) o))))
    (princ "(setvar \"filedia\" 0)\n._new\n\n(load\"zlc\")\ncabc" f)(mapcar '(lambda (x)(princ (strcat "\n._open\n" x c) f)) o)
      (princ "\n" f)(princ "._close" f) (close f) (gc) (command "_.script" s))
; zoom - lock viewports
(defun c:zlv ( / a d l e)
  (vlax-for l (vla-get-layouts (setq d (vla-get-activedocument (setq a (vlax-get-acad-object)))))
    (vla-put-activelayout d l)(if (eq acpaperspace (vla-get-activespace d))(vla-put-mspace d :vlax-false))(vla-ZoomExtents a)
    (vlax-for e (vla-get-block l)(if (= (vla-get-objectname e) "AcDbViewport")(vla-put-displaylocked e :vlax-true)))))
; close all but current
(defun c:cabc ( / d )
  (vlax-for d (vla-get-Documents (vlax-get-acad-object))
    (if	(= (vla-get-Active d) :vlax-False) (if (= (vla-get-ReadOnly d) :vlax-true) (vla-close d :vlax-False)
      (vl-catch-all-apply (function (lambda ()(if (/= (getvar "dwgtitled") 0)(vla-save d))(vla-close d :vlax-False))))))))
(vl-load-com) (princ "\nZoom-Lock-Close (RLX 10/2018) : type ZLC to start\n") (princ)

 

Edited October 5, 2018 by rlx
added a few extra checks