社区 › VB › 对VBA的援助

terrycadd 发表于 2007-4-27 10:51:41

对VBA的援助

以下VBA代码是Matt W在AutoLISP线程中提交的：
“对所有打开的图纸执行命令”。
如果当前图纸是打开的图纸列表中的最后一个，则效果很好，否则会崩溃。
我不精通VBA，需要一些修改VBA代码的帮助来执行以下操作：
1.在打开的图纸列表中确定当前图纸的iDwgCnt。
2.在For each循环中跳过此iDwgCnt图纸。
3.循环结束后，执行当前图纸上跳过的两行。
提前感谢。
：丑陋：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)
)
**** Hidden Message *****

terrycadd 发表于 2007-4-27 11:11:50

我刚刚运行了它，它对我来说工作得很好。 我使用的是 2007。
我注意到，在这样的过程中使用 SendCommand 从 VBA 调用 LSP 时，vbCrLf 比 vbCr 工作得更好。 我不知道为什么，但有时它确实如此，有时它没有。 尝试进行更改，看看会发生什么。

jjs 发表于 2007-4-27 12:12:27

马特，
感谢您的快速回复。 我用vbCrLf替换了vbCr，只有当当前图形是打开的图形列表中的最后一个图形时，它仍然有效。 但是，错误消息从“执行错误”更改为更糟。 它在当前图形之后锁定图形中的AutoCAD，文本屏幕显示错误“执行错误”，“卸载VBA项目”，“***内部错误”，“VL命名空间不匹配”。
我们正在运行2005年和2006年。在2007年过时之前，我们可能不会得到它。 （哈！
这是我一直在测试的lisp代码。
(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 发表于 2007-4-27 13:12:42

来自旧的vbdesign/cadvault网站的mark Johnson有一个vba例程，我想你会喜欢。一些老卡德沃特人可能记得他的网站的名字。也许他是这里的一员。我不知道。他为一家橱柜制造商工作。我认为他的网站是3D绘图或类似的东西。

terrycadd 发表于 2007-4-27 13:22:29

多文件是它的名字。到目前为止，我还没有找到它。一些旧计时器可能把它放在tho周围。我想高清崩溃处理了我的旧副本。

terrycadd 发表于 2007-4-30 14:55:30

已通过以下链接回答了VBA问题：
http://tech.groups.yahoo.com/group/AutoCAD_Connections/message/270
对于那些无法登录雅虎群组的用户，这里是修改后的代码。
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).FullNamestrThisDwg 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

查看完整版本: 对VBA的援助