对VBA的援助

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

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

copy

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)
)

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

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代码。

copy

(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
对于那些无法登录雅虎群组的用户，这里是修改后的代码。

copy

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

对VBA的援助

发表回复

精选推荐