乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 59|回复: 5

对VBA的援助

[复制链接]

3

主题

11

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2007-4-27 10:51:41 | 显示全部楼层 |阅读模式
以下VBA代码是Matt W在AutoLISP线程中提交的:
“对所有打开的图纸执行命令”。
如果当前图纸是打开的图纸列表中的最后一个,则效果很好,否则会崩溃。
我不精通VBA,需要一些修改VBA代码的帮助来执行以下操作:
1.在打开的图纸列表中确定当前图纸的iDwgCnt。
2.在For each循环中跳过此iDwgCnt图纸。
3.循环结束后,执行当前图纸上跳过的两行。
提前感谢。
:丑陋:Terry Cadd:loco:
  1. Option Explicit
  2. Public Const AppName = "VBA Thing-a-ma-jig"
  3. Public Sub Main()
  4.     Dim oDwg As AcadDocument
  5.     Dim oAcad As AcadApplication
  6.     Dim iDwgCnt As Integer
  7.     Set oAcad = AcadApplication.Application
  8.     iDwgCnt = 0
  9.     For Each oDwg In oAcad.Documents
  10.         oAcad.Documents.Item(iDwgCnt).Activate
  11.         oDwg.SendCommand "(load ""VBA.lsp"")" & vbCr & "VBA" & vbCr
  12.         iDwgCnt = iDwgCnt + 1
  13.     Next oDwg
  14.     MsgBox "Done!", vbInformation + vbOKOnly, AppName
  15. End Sub
  16. ;-----------------------------------------------------
  17. (defun C:VBA ( / ); These commands may be customized as needed.
  18.    (command "tilemode" 1)
  19.    (command "zoom" "e")
  20.    (command "qsave")
  21.    (princ)
  22. )

本帖以下内容被隐藏保护;需要你回复后,才能看到!

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

使用道具 举报

3

主题

11

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2007-4-27 11:11:50 | 显示全部楼层
我刚刚运行了它,它对我来说工作得很好。 我使用的是 2007。
我注意到,在这样的过程中使用 SendCommand 从 VBA 调用 LSP 时,vbCrLf 比 vbCr 工作得更好。 我不知道为什么,但有时它确实如此,有时它没有。 尝试进行更改,看看会发生什么。
回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2007-4-27 12:12:27 | 显示全部楼层
马特,
感谢您的快速回复。 我用vbCrLf替换了vbCr,只有当当前图形是打开的图形列表中的最后一个图形时,它仍然有效。 但是,错误消息从“执行错误”更改为更糟。 它在当前图形之后锁定图形中的AutoCAD,文本屏幕显示错误“执行错误”,“卸载VBA项目”,“***内部错误”,“VL命名空间不匹配”。
我们正在运行2005年和2006年。在2007年过时之前,我们可能不会得到它。 (哈!
这是我一直在测试的lisp代码。
  1. (defun c:QSA ()
  2.   (princ "\nQsave all open drawings. ")
  3.   (OpenDwgsCmds
  4.     (list "(setq Layout1 (nth 0 (LayoutList)))" "LAYOUT S" "!Layout1" "PSPACE" "ZOOM E" "QSAVE")
  5.   )
  6.   (princ)
  7. );defun c:QSA
  8. (defun OpenDwgsCmds (ListCmds@ / Cmd$ FileName%)
  9.   (if (not (findfile "C:\\Temp\\Temp.scr"))
  10.     (progn (vl-load-com)(vl-mkdir "C:\\Temp"))
  11.   );if
  12.   (setq FileName% (open "C:\\Temp\\Temp.scr" "w"))
  13.   (foreach Cmd$ ListCmds@
  14.     (write-line Cmd$ FileName%)
  15.   );foreach
  16.   (close FileName%)
  17.   (command "vbaload" "OpenDwgsCmds.dvb")
  18.   (command "-vbarun" "thisdrawing.Main")
  19.   (command "vbaunload" "OpenDwgsCmds.dvb")
  20.   (princ)
  21. );defun OpenDwgsCmds
  22. (defun c:OpenDwgsCmds (/ FileName%)
  23.   (command "SCRIPT" "C:\\Temp\\Temp.scr")
  24.   (princ)
  25. );defun c:OpenDwgsCmds
  26. ; Here is my OpenDwgsCmds.dvb before I made the vbCrLf changes.
  27. ;Option Explicit
  28. ;Sub Main()
  29. ;  Dim oDwg As AcadDocument
  30. ;  Dim oAcad As AcadApplication
  31. ;  Dim iDwgCnt As Integer
  32. ;  Set oAcad = AcadApplication.Application
  33. ;  iDwgCnt = 0
  34. ;  For Each oDwg In oAcad.Documents
  35. ;    oAcad.Documents.Item(iDwgCnt).Activate
  36. ;    oDwg.SendCommand "(load ""OpenDwgsCmds.lsp"")" & vbCr & "OpenDwgsCmds" & vbCr
  37. ;    iDwgCnt = iDwgCnt + 1
  38. ;  Next oDwg
  39. ;End Sub

回复

使用道具 举报

jjs

6

主题

49

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
73
发表于 2007-4-27 13:12:42 | 显示全部楼层
来自旧的vbdesign/cadvault网站的mark Johnson有一个vba例程,我想你会喜欢。一些老卡德沃特人可能记得他的网站的名字。也许他是这里的一员。我不知道。他为一家橱柜制造商工作。我认为他的网站是3D绘图或类似的东西。
回复

使用道具 举报

3

主题

11

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2007-4-27 13:22:29 | 显示全部楼层
多文件是它的名字。到目前为止,我还没有找到它。一些旧计时器可能把它放在tho周围。我想高清崩溃处理了我的旧副本。
回复

使用道具 举报

3

主题

11

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2007-4-30 14:55:30 | 显示全部楼层
已通过以下链接回答了VBA问题:
http://tech.groups.yahoo.com/group/AutoCAD_Connections/message/270
对于那些无法登录雅虎群组的用户,这里是修改后的代码。
  1. Option Explicit
  2. Sub Main()
  3.   Dim objDwg As AcadDocument
  4.   Dim objAcad As AcadApplication
  5.   Dim intDwgCnt As Integer
  6.   Dim strThisDwg As String
  7.   Dim intThisDwg As Integer
  8.   Set objAcad = AcadApplication.Application
  9.   intDwgCnt = 0
  10.   strThisDwg = ThisDrawing.FullName
  11.   For Each objDwg In objAcad.Documents
  12.     If objAcad.Documents.Item(intDwgCnt).FullName  strThisDwg Then
  13.       objAcad.Documents.Item(intDwgCnt).Activate
  14.       objDwg.SendCommand "(load ""VBA-Test.lsp"")" & vbCr & "VBA-Test" & vbCr
  15.     Else
  16.       intThisDwg = intDwgCnt
  17.     End If
  18.     intDwgCnt = intDwgCnt + 1
  19.   Next objDwg
  20.   objAcad.Documents.Item(intThisDwg).Activate
  21.   ThisDrawing.SendCommand "(load ""VBA-Test.lsp"")" & vbCr & "VBA-Test" & vbCr
  22. End Sub
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 18:35 , Processed in 0.831754 second(s), 65 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表