;-------------------------------------------------------------------------------
; Program Name: OpenDwgsCmds.lsp [OpenDwgsCmds R2]
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
;               (URL: http://web2.airmail.net/terrycad)
; Date Created: 2-7-07
; Function:     Executes commands and functions on all open drawings.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM    2-7-07   Initial version
; 2    TM    5-1-07   Revised functions and OpenDwgsCmds.dvb.
;-------------------------------------------------------------------------------
; OpenDwgsCmds - Main function that runs the other functions
; Arguments: 1
;   ListCmds@ = List of commands and functions to execute
; Returns: Executes list of commands and functions on all open drawings
; Syntax example: (OpenDwgsCmds (list "line 0,0 100,100" "" "(c:PurgeAll)" "zoom e"))
;-------------------------------------------------------------------------------
(defun OpenDwgsCmds (ListCmds@ / Cmd$ FileName%)
  (if (not (findfile "C:\\Temp\\Temp.scr"))
    (progn (vl-load-com)(vl-mkdir "C:\\Temp"))
  );if
  (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
  (foreach Cmd$ ListCmds@
    (write-line Cmd$ FileName%)
  );foreach
  (close FileName%)
  (command "vbaload" "OpenDwgsCmds.dvb")
  (command "-vbarun" "thisdrawing.Main")
  (command "vbaunload" "OpenDwgsCmds.dvb")
  (princ)
);defun OpenDwgsCmds
;-------------------------------------------------------------------------------
; c:CDC - Current Drawing Commands version of the OpenDwgsCmds function
;-------------------------------------------------------------------------------
(defun c:CDC (/ Cmd$ FileName% ListCmds@ Loop)
  (princ "\nExecute commands and functions on current drawing")
  (setq Loop t)
  (while Loop
    (setq Cmd$ (getstring "\nEnter command or function, or type 'END' to end: " t))
    (if (= (strcase Cmd$) "END")
      (setq Loop nil)
      (setq ListCmds@ (append ListCmds@ (list Cmd$)))
    );if
  );while
  (if ListCmds@
    (progn
      (if (not (findfile "C:\\Temp\\Temp.scr"))
        (progn (vl-load-com)(vl-mkdir "C:\\Temp"))
      );if
      (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
      (foreach Cmd$ ListCmds@
        (write-line Cmd$ FileName%)
      );foreach
      (close FileName%)
      (command "SCRIPT" "C:\\Temp\\Temp.scr")
    );progn
  );if
  (princ)
);defun c:CDC
;-------------------------------------------------------------------------------
; c:ODC - Open Drawings Commands version of the OpenDwgsCmds function
;-------------------------------------------------------------------------------
(defun c:ODC (/ Cmd$ ListCmds@ Loop)
  (princ "\nExecute commands and functions on all open drawings")(princ)
  (setq Loop t)
  (while Loop
    (setq Cmd$ (getstring "\nEnter command or function, or type 'END' to end: " t))
    (if (= (strcase Cmd$) "END")
      (setq Loop nil)
      (setq ListCmds@ (append ListCmds@ (list Cmd$)))
    );if
  );while
  (if ListCmds@
    (OpenDwgsCmds ListCmds@)
  );if
  (princ)
);defun c:ODC
;-------------------------------------------------------------------------------
; c:OpenDwgsCmds - Executed by OpenDwgsCmds.dvb
;-------------------------------------------------------------------------------
(defun c:OpenDwgsCmds (/ FileName%)
  (command "SCRIPT" "C:\\Temp\\Temp.scr")
  (princ)
);defun c:OpenDwgsCmds
;-------------------------------------------------------------------------------
; Start of OpenDwgsCmds Support Utility Functions
;-------------------------------------------------------------------------------
; OpenDwgsCmds.dvb - vba part of the code
;-------------------------------------------------------------------------------
;Option Explicit
;Sub Main()
;  Dim objDwg As AcadDocument
;  Dim objAcad As AcadApplication
;  Dim intDwgCnt As Integer
;  Dim strThisDwg As String
;  Dim intThisDwg As Integer
;  Set objAcad = AcadApplication.Application
;  intDwgCnt = 0
;  strThisDwg = ThisDrawing.FullName
;  For Each objDwg In objAcad.Documents
;    If objAcad.Documents.Item(intDwgCnt).FullName <> strThisDwg Then
;      objAcad.Documents.Item(intDwgCnt).Activate
;      objDwg.SendCommand "(load ""OpenDwgsCmds.lsp"")" & vbCr & "OpenDwgsCmds" & vbCr
;    Else
;      intThisDwg = intDwgCnt
;    End If
;    intDwgCnt = intDwgCnt + 1
;  Next objDwg
;  objAcad.Documents.Item(intThisDwg).Activate
;  ThisDrawing.SendCommand "(load ""OpenDwgsCmds.lsp"")" & vbCr & "OpenDwgsCmds" & vbCr
;End Sub
;-------------------------------------------------------------------------------
; c:QSA - Commands Pspace, Zoom E, and Qsave on all open drawings
;-------------------------------------------------------------------------------
(defun c:QSA (/ CmdList@)
  (princ "\nQsave all open drawings. ")
  (setq CmdList@ (list
    "(if (/= (getvar \"CTAB\") \"Model\") (command \"._PSPACE\"))"
    "ZOOM E"
    "(if (/= (getvar \"DWGTITLED\") 0) (command \"._QSAVE\"))"
  ));list;setq
  (OpenDwgsCmds CmdList@)
  (princ)
);defun c:QSA
;-------------------------------------------------------------------------------
(princ);End of OpenDwgsCmds