Topic: Assistance with VBA Thing-a-ma-jig

[terrycadd]

The following VBA code was submitted by Matt W in the AutoLISP thread:
"Execute commands on all open drawings". 
It works great if the current drawing is the last in the list of open drawings, else it crashes.
I am not proficient in VBA, and need some help in modifying the VBA code to do the following:

1. Determine the iDwgCnt of the current drawing in the list of open drawings.
2. Skip over this iDwgCnt drawing in the For Each loop.
3. After the loop, execute the two skipped over lines on the current drawing.

Thanks in advance.
 :ugly: Terry Cadd  :loco:

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
;-----------------------------------------------------
(defun C:VBA ( / ); These commands may be customized as needed.
   (command "tilemode" 1)
   (command "zoom" "e")
   (command "qsave")
   (princ)
)

[Guest]

I just ran it and it worked just fine for me.  I'm using 2007.

I have noticed that when using SendCommand to call a LSP from VBA in a process like this, vbCrLf works better than vbCr.  I'm not sure why, but sometimes it does and sometimes it doesn't.  Try making that change and see what happens.

[terrycadd]

Matt,
Thanks for your quick reply.  I replaced the vbCr's with vbCrLf's, and it still only works if the current drawing is the last drawing in the list of open drawings.  However, the error messages changed from "Execution error" to worse.  It locks up AutoCAD in the drawing after the current drawing and the text screen displays the error "Execution error", "Unload VBA Project", "*** INTERNAL ERROR", "VL namespace mismatch". 
We're running 2005 and 2006. We probably won't be getting 2007 until it goes out of date. (ha!)
Here's the lisp code I've been testing.

Code: [Select]

(defun c:QSA ()
  (princ "\nQsave all open drawings. ")
  (OpenDwgsCmds
    (list "(setq Layout1 (nth 0 (LayoutList)))" "LAYOUT S" "!Layout1" "PSPACE" "ZOOM E" "QSAVE")
  )
  (princ)
);defun c:QSA

(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

(defun c:OpenDwgsCmds (/ FileName%)
  (command "SCRIPT" "C:\\Temp\\Temp.scr")
  (princ)
);defun c:OpenDwgsCmds

; Here is my OpenDwgsCmds.dvb before I made the vbCrLf changes.
;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


[jjs]

mark johnson from the old vbdesign/cadvault site had a vba routine that I think you would like. Some of the old cadvaulters may remember his site's name. Maybe he is a member here. I don't know. He worked for a cabinet maker. I think his site was 3d drafting or something to that effect.

[jjs]

multifile is the name of it. I have not been able to find it so far. Some of the old timers may have it laying around tho. HD crash took care of my old copy I think.

[terrycadd]

The VBA question was answered on the following link:
http://tech.groups.yahoo.com/group/AutoCAD_Connections/message/270
For those who are unable to log into yahoo groups here is the revised code.

Code: [Select]

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 ""VBA-Test.lsp"")" & vbCr & "VBA-Test" & vbCr
    Else
      intThisDwg = intDwgCnt
    End If
    intDwgCnt = intDwgCnt + 1
  Next objDwg
  objAcad.Documents.Item(intThisDwg).Activate
  ThisDrawing.SendCommand "(load ""VBA-Test.lsp"")" & vbCr & "VBA-Test" & vbCr
End Sub