[VBA程序]：acad r14 vba

archt

r14的vba中没有sendcommand这个命令
不知道大家是如何解决vba中调用lisp命令的?

efan2000

这是使用API函数来实现SendCommand功能的。

2. 
   
3.   [FONT=courier new]
   
4. Option Explicit
   
5. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd
   
6. As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
7. Declare Function GetForegroundWindow Lib "user32" () As Long
   
8. Public Const WM_COPYDATA = &H4A
   
9. Type COPYDATASTRUCTURE
   
10.   dwData As Long
    
11.   cbData As Long
    
12.   lpData As String
    
13. End Type
    
14. Dim datas As COPYDATASTRUCTURE
    
15. Public Sub SendCommand(ACadCommand As String)
    
16. datas.dwData = 1
    
17. datas.lpData = ACadCommand & vbCr
    
18. datas.cbData = Len(ACadCommand) + 2
    
19. AppActivate ThisDrawing.Application.Caption
    
20. SendMessage GetForegroundWindow, WM_COPYDATA, 0, datas
    
21. End Sub
    
22. 
    
23. '调用方法示例
    
24. Private Sub UserForm_Click()
    
25. Me.hide
    
26. Call SendCommand("Insert")
    
27. Me.Show
    
28. End Sub
    
29. 
    
30.   [/FONT]
    

<br />   [FONT=courier new]<br /> Option Explicit<br /> Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd<br /> As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long<br /> Declare Function GetForegroundWindow Lib "user32" () As Long<br /> Public Const WM_COPYDATA = &H4A<br /> Type COPYDATASTRUCTURE<br />   dwData As Long<br />   cbData As Long<br />   lpData As String<br /> End Type<br /> Dim datas As COPYDATASTRUCTURE<br /> Public Sub SendCommand(ACadCommand As String)<br /> datas.dwData = 1<br /> datas.lpData = ACadCommand & vbCr<br /> datas.cbData = Len(ACadCommand) + 2<br /> AppActivate ThisDrawing.Application.Caption<br /> SendMessage GetForegroundWindow, WM_COPYDATA, 0, datas<br /> End Sub<br /> <br /> '调用方法示例<br /> Private Sub UserForm_Click()<br /> Me.hide<br /> Call SendCommand("Insert")<br /> Me.Show<br /> End Sub<br /> <br />   [/FONT]<br />

archt

无效呀

efan2000

你是如何调用的，将程序贴出来查明一下原因。

archt

Private Sub DwgThumbnail1_DblClick()
Dim lispcommands As String
lisp = "insert " & DwgThumbnail1.DwgFileName
浏览窗体.Hide
SendCommand (lisp)
浏览窗体.Show
End Sub

屏幕一闪，acad没有任何变化，就回到窗体了

efan2000

一、要把这一句AppActivate ThisDrawing.Application.Caption[/COLOR] 改成AppActivate acadApp.Caption，其中acadApp代表Application对象。当然也可以放到SendCommand过程的外面，如

1. 
   
2.   [FONT=courier new]
   
3. AppActivate acadApp.Caption
   
4. SendCommand (lisp)
   
5.   [/FONT]
   

复制代码

只有将AutoCAD窗口激活了才能使用SendCommand。
二、lisp = "insert " & DwgThumbnail1.DwgFileName，如果不显示块插入对话框，那么在Insert之前应加上一个“-”。如：lisp = "-INSERT " & DwgThumbnail1.DwgFileName。

archt

一、在r14 中，thisdrawing 特别不能取消！我用sendcommand肯定是激活了acad的窗口的。
二、vba中使用lisp，我就是需要insert的动态拖动

下面的程序是mjtd提供的，我修改了一下，可能在r14下正常运行，但是还是不能支持insert动态显示后，再返回vba


Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Const WM_COPYDATA = &H4A
  Type COPYDATASTRUCTURE
    dwData As Long
    cbData As Long
    lpData As String
  End Type

Public Sub SendCommand(CommandString As String)
    Dim udtData As COPYDATASTRUCTURE
    Dim lngHwnd As Long
    udtData.dwData = 1
    udtData.lpData = CommandString
    udtData.cbData = LenB(CommandString) + 2
    lngHwnd = FindWindow(vbNullString, ThisDrawing.Application.Caption)
    SendMessage lngHwnd, WM_COPYDATA, 0, udtData
End Sub

efan2000

可能你对“-”的用法还有点误解，AutoCAD的说明是这样：When you prefix certain commands with a minus sign (-), the AutoCAD&reg; software does not display dialog boxes for the duration of that command. The next time you run the command without using the minus sign (-) prefix, AutoCAD displays dialog boxes as normal.。意思是说当前命令之前如果带负号，比如-bhatch，表示AutoCAD在运行命令期间不显示对话框。如果下次运行此命令，但不带负号，那么就如正常时显示对话框。
因而，在调用这句之后SendCommand "-insert " & DwgThumbnail1.DwgFileName，将直接显示动态拖动的效果。
如果在VB中将thisdrawing 声明为文档对象，那么它的用法就没有错误，但是在VB中，一般声明了一个Application的对象，比如acadApp，那么这句lngHwnd = FindWindow(vbNullString, ThisDrawing.Application.Caption)就可以简写为：lngHwnd = FindWindow(vbNullString, acadApp.Caption)。

archt

感谢你的答复，其实我不是想讨论关于-&_的问题
我敢肯定你没有装r14&vba,有些时候理论和实际有差异,特别是office安装以后！照你的写法,在r14下肯定出错。

efan2000

我确实没有安装R14，是在R2000和R2004下试验的。如果是Office在AutoCAD之后安装的，那么要重新安装VBA，这样才避免VBA组件被Office的覆盖。