Topic: Execute commands on all open drawings

[Guest]

Matt W.
In your code is it possible to pass arguments of commands or functions, so anybody can customize it as they need to? Or are we limited to editing VBA code per each change we want to make?
TC

So if I understand you correctly, you want to make it a hybrid app that runs LSP programs?  Look into SendCommand. *shudders*

OR, you might want to do a search for 'James Buzbee'.  He's posted some hybrid apps here.

Personally, I try to avoid calling a LSP program from a VBA app.  If it can't be done with VBA or it's WAY TOO much coding (and sometimes it is - just look at how many lines of code you need to draw a line), I'll usually do it with LSP.

[Keith™]

Can't you zoom with points? Zoom > Window > 0,0 > 11,17

Not unless the document is active, if it is not active, AutoCAD cannot redraw the objects at the prescribed zoom level. Since redrawing is a function of the window (WMPAINT event) it cannot be accomplished unless the window is active.

[terrycadd]

Per the following post, wouldn’t you have to close all open drawings and re-open them?  Wouldn’t that be too much trouble?

Code: [Select]

Would it be an acceptable alternative to have a program open each drawing in succession
and perform a given set of tasks on each one instead of having the program performs the
tasks on all open drawings simultaneously?
Another thought was if I created a temp script on the fly of the various commands or functions I wanted to execute on all open drawings, then couldn’t vba run the same temp script on each drawing.

I haven’t written anything using the sendcommand, so I need to research it further.  Any examples would be appreciated.

[Keith™]

Use ScriptPro (or whatever it is called now) and simply script the LISP commands for the drawings you need modified.

[Guest]

TC:
Give this a shot.  This uses SendCommand to load and run VBA.lsp.

DVB code

Code: [Select]

Option Explicit

Public Const AppName = "VBA Thing-a-ma-jig"

Public Sub Main()
    Dim oDwg As AcadDocument
    Dim oAcad As AcadApplication
    Dim iDwgCnt As Integer
   
    Set oAcad = AcadApplication.Application
   
    iDwgCnt = 0
   
    For Each oDwg In oAcad.Documents
        oAcad.Documents.Item(iDwgCnt).Activate
        oDwg.SendCommand "(load ""VBA.lsp"")" & vbCr & "vba" & vbCr
       
        iDwgCnt = iDwgCnt + 1
    Next oDwg
   
    MsgBox "Done!", vbInformation + vbOKOnly, AppName
End Sub
VBA.LSP file

Code: [Select]

(defun C:VBA ( / )
   (command "tilemode" 1)
   (command "zoom" "e")
   (command "qsave")
   (princ)
)

(princ)

[terrycadd]

Matt, I couldn't get this Thing-a-ma-jig to work so I left it out and it worked ok.
i.e.  Public Const AppName = "VBA Thing-a-ma-jig"
Also, I wasn't able to have it run a script on every drawing, so I just modified the function to read in the script file and execute one line at a time. It's able to determine a function by enclosing them in parenthesis. 
Thanks for everyone’s help.
TC

Code: [Select]

; OpenDwgsCmds - Main function that runs the other functions
; Syntax example: (OpenDwgsCmds (list "zoom" "e" "line" "0,0" "100,100" "" "(c:PurgeAll)"))
; Note: Put the functions at the end of the list.
(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:OpenDwgsCmds - Executed by OpenDwgsCmds.dvb
(defun c:OpenDwgsCmds (/ Cmd$ FileName%)
  ;(command "SCRIPT" "C:\\Temp\\Temp.scr");This caused an Execution error
  (setq FileName% (open "C:\\Temp\\Temp.scr" "r"))
  (while (setq Cmd$ (read-line FileName%))
    (if (= (substr Cmd$ 1 1) "(")
      (eval (read Cmd$));functions
      (command Cmd$);commands
    );if
  );while
  (close FileName%)
  (princ)
);defun c:OpenDwgsCmds
OpenDwgsCmds.dvb - vba part of the code

Code: [Select]

Option Explicit
Sub Main()
  Dim oDwg As AcadDocument
  Dim oAcad As AcadApplication
  Dim iDwgCnt As Integer
  Set oAcad = AcadApplication.Application
  iDwgCnt = 0
  For Each oDwg In oAcad.Documents
    oAcad.Documents.Item(iDwgCnt).Activate
    oDwg.SendCommand "(load ""OpenDwgsCmds.lsp"")" & vbCr & "OpenDwgsCmds" & vbCr
    iDwgCnt = iDwgCnt + 1
  Next oDwg
End Sub


[Guest]

Glad you got everything working!!

Matt, I couldn't get this Thing-a-ma-jig to work so I left it out and it worked ok.
i.e.  Public Const AppName = "VBA Thing-a-ma-jig"

That's just the "name" that I gave the program.  The only time it was used was at the end when the dialog box popped up saying everything was done.

[terrycadd]

I'd been wanting to have a function like this, since I first started using AutoCAD 2000.  I can't believe how quickly it all came together with you guys help.  Here is a quick command line version, which uses the above functions.
TC

Code: [Select]

; c:ODC - Quick command version of the OpenDwgsCmds function
(defun c:ODC (/ Cmd$ ListCmds@ Loop)
  (princ "\nExecute commands and functions on all open drawings")
  (setq Loop t)
  (while Loop
    (setq Cmd$ (getstring "\nEnter command or function, or type 'END' to end: " t))
    (if (/= (strcase Cmd$) "END")
      (setq ListCmds@ (append ListCmds@ (list Cmd$)))
      (setq Loop nil)
    );if
  );while
  (if ListCmds@
    (OpenDwgsCmds ListCmds@)
  );if
  (princ)
);defun c:ODC


[terrycadd]

After testing this function for a few days, I’ve found out that it can run a script, and the reason for the occasional “Execution error” was that it must be run from the last in the list of open drawings. I added the c:CDC, Current Drawing Commands, to be able to test your commands in the current drawing before running them on all open drawings. I’ve attached OpenDwgsCmds.dvb, the vba part of the code, for those who may unfamiliar or uncomfortable with creating vba code.

Code: [Select]

;-------------------------------------------------------------------------------
; 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"))
; Note: The current drawing must be the last in the list of open drawings.
;-------------------------------------------------------------------------------
(defun OpenDwgsCmds (ListCmds@ / Cmd$ CurrentDwg$ FileName%)
  (setq CurrentDwg$ (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
  (if (/= CurrentDwg$ (last (GetDwgsList)))
    (progn
      (alert (strcat "To run the function OpenDwgsCmds,\n"
                     "the current drawing must be the last\n"
                     "in the list of open drawings.")
      );alert
      (ActivateDwg (last (GetDwgsList)))
      (exit)
    );progn
  );if
  (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
; Note: The current drawing must be the last in the list of open drawings.
;-------------------------------------------------------------------------------
(defun c:ODC (/ Cmd$ CurrentDwg$ ListCmds@ Loop)
  (princ "\nExecute commands and functions on all open drawings")(princ)
  (setq CurrentDwg$ (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
  (if (/= CurrentDwg$ (last (GetDwgsList)))
    (progn
      (alert (strcat "To run the function ODC, Open Drawings\n"
                     "Commands, the current drawing must be\n"
                     "the last in the list of open drawings.")
      );alert
      (ActivateDwg (last (GetDwgsList)))
      (exit)
    );progn
  );if
  (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 ()
  (command "SCRIPT" "C:\\Temp\\Temp.scr")
  (princ)
);defun c:OpenDwgsCmds
;-------------------------------------------------------------------------------
; Start of OpenDwgsCmds Support Utility Functions
;-------------------------------------------------------------------------------
; GetDwgsList - Returns a list of open drawings
; Use (length (GetDwgsList)) for the number of open drawings.
;-------------------------------------------------------------------------------
(defun GetDwgsList (/ AcadOBJ DocsOBJ DwgsList@)
  (if (>= (atoi (getvar "ACADVER")) 15)
    (progn
      (setq AcadOBJ (vlax-get-acad-object)
            DocsOBJ (vlax-get-property AcadOBJ "Documents")
            DwgsList@ nil
      );setq
      (vlax-for ForItem DocsOBJ
        (setq DwgsList@ (cons (strcat (vlax-get-property ForItem "Path") "\\"
        (vlax-get-property ForItem "Name")) DwgsList@))
      );vlax-for
      (setq DwgsList@ (reverse DwgsList@))
    );progn
    (setq DwgsList@ (list (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))))
  );if
  DwgsList@
);defun GetDwgsList
;-------------------------------------------------------------------------------
; ActivateDwg - Switches between open drawings
; Arguments: 1
;   DwgPathFilename$ = Path and filename string of drawing
; Returns: Makes the drawing of DwgPathFilename$ current
;-------------------------------------------------------------------------------
(defun ActivateDwg (DwgPathFilename$ / Cnt# Num#)
  (setq Cnt# 0 Num# 0)
  (foreach Item (GetDwgsList)
    (if (= (strcase DwgPathFilename$) (strcase Item))
      (setq Num# Cnt#)
    );if
    (setq Cnt# (1+ Cnt#))
  );foreach
  (command "vbastmt" (strcat "Application.Documents.Item(" (itoa Num#) ").Activate"))
  (princ)
);defun ActivateDwg
;-------------------------------------------------------------------------------
; 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
;-------------------------------------------------------------------------------
(princ);End of OpenDwgsCmds


[jessebelcher]

Hello i am very new to this lisp and vba stuff. Can you  tell me how to use this file. I have the above saved in a text file. Better yet can you point me to a site that tells you how to run vba. I know how to use lisp files (cant write them very well) but the vba part has me stumped. I am willing to learn on my own just need a little push in the right direction.

Thanks.

JB

[terrycadd]

You can copy and paste the contents into NotePad and save the file as OpenDwgsCmds.lsp in a folder in your AutoCAD search path. Then download the OpenDwgsCmds.dvb and copy it there also. To load the function on the command line type (load "OpenDwgsCmds")

To test the quick command line version try the CDC, Current Drawing Commands function.
Command: CDC
Execute commands and functions on current drawing
Enter command or function, or type 'END' to end: tilemode 1
Enter command or function, or type 'END' to end: zoom e
Enter command or function, or type 'END' to end: qsave
Enter command or function, or type 'END' to end: end

To test the open drawings version try the ODC, Open Drawings Commands function.
Command: ODC
Execute commands and functions on all open drawings
Enter command or function, or type 'END' to end: tilemode 1
Enter command or function, or type 'END' to end: zoom e
Enter command or function, or type 'END' to end: qsave
Enter command or function, or type 'END' to end: end

You can also include AutoCAD functions by enclosing them in parenthesis. i.e. (c:PurgeAll) etc.
There are a lot of things that you can do similar to running a script file. It's up to your needs and imagination.

The programming version of the above example would look like the following:
(OpenDwgsCmds (list "tilemode 1" "zoom e" "qsave"))