TheSwamp
Code Red => VB(A) => Topic started by: terrycadd on April 27, 2007, 10:51:41 AM
-
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:
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)
)
-
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.
-
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. :cry: (ha!)
Here's the lisp code I've been testing.
(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
-
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.
-
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.
-
The VBA question was answered on the following link:
http://tech.groups.yahoo.com/group/AutoCAD_Connections/message/270 (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.
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