VB窗口中一个命令调用另一命令

Kye

读这个贴【请问能将cad窗口设为当前窗口吗】http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110889&fromuid=7303474
想将exe窗口调用至前台，捣鼓了一天，百度到一句话任务栏的窗口API 中的bringwindowtotop SetWindowPos SetForegroundWindow无法实现将其调至前台，遂放弃

从这个https://zhidao.baidu.com/question/1493962773300152419.html 和http://bbs.csdn.net/topics/390328728 学习了可以用如题的用法，实现了VB--->LSP---->VB




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;分割线2020-05-29;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;仅仅填加了备注，程序无实际变化 当年写这句VB--->LSP---->VB 现在看来我自己都有点莫名其妙

'一般情况下,VB中运行lisp命令只能放入程序的末端如Command1<VB其他内容+LISP 构成了完整VB命令>

'此程序示例实现了lisp命令前置即 [完整VB 命令<含LISP命令>]+[VB其他内容构成一个新的VB命令

'也就是VB命令==[完整VB 命令<含LISP命令>]+[VB其他内容] 完成 lisp命令前置

1. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
   
2.      ByVal lpClassName As String, _
   
3.      ByVal lpWindowName As String) As Long
   
4. Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
   
5.      ByVal hWnd1 As Long, _
   
6.      ByVal hWnd2 As Long, _
   
7.      ByVal lpsz1 As String, _
   
8.      ByVal lpsz2 As String) As Long
   
9. Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
   
10.      ByVal hwnd As Long, _
    
11.      ByVal wMsg As Long, _
    
12.      ByVal wParam As Long, _
    
13.      ByVal lParam As Long) As Long
    
14. Private Const WM_LBUTTONDOWN As Long = &H201
    
15. Private Const WM_LBUTTONUP As Long = &H202
    
16. Dim hDest As Long           '目标按钮句柄
    
17. Private Sub Command1_Click()
    
18. On Error GoTo ErrHandler
    
19. 
    
20.    
    
21.    
    
22. '''连接cad
    
23.     Dim acadapp As Object  'AcadApplication
    
24.     Dim Thisdrawing As Object  'AcadDocument
    
25.    ' Dim thisDrawing As Object
    
26.     Set acadapp = GetObject(, "AutoCAD.Application")
    
27.     If Err Then
    
28.         Err.Clear
    
29.         Set acadapp = CreateObject("AutoCAD.Application")
    
30.         If Err Then
    
31.             MsgBox Err.Description
    
32.             End
    
33.             Exit Sub
    
34.         End If
    
35.     End If
    
36.     acadapp.Visible = True
    
37.     Set Thisdrawing = acadapp.ActiveDocument
    
38.     Thisdrawing.SendCommand "TEST" & vbCr '应该改进cad程序运行成功应该将这些数据从库中删除
    
39. 
    
40. ErrExit:
    
41.    
    
42.     Exit Sub
    
43.    
    
44. ErrHandler:
    
45.     MsgBox "运行时发生意外，请检查AutoCAD文件是否打开!", vbCritical, "提示"
    
46.     GoTo ErrExit
    
47. End Sub
    
48. Private Sub Command2_Click()
    
49. MsgBox "测试怎么样?"
    
50. End Sub
    
51. Private Sub Command3_Click()'==================================================
    
52. '时间长了,加个备注<2020-05-29>
    
53. '1.  form_load的内容<示例中调用command2>,同理 也可实现调用Command1
    
54. '2.  如调用command1的内容<即lisp>,也就是lisp命令可以前置 ,再运行其他vb内容
    
55. '==================================================
    
56. End Sub
    
57. Private Sub Form_Load()
    
58. '==================================================
    
59. '时间长了,加个备注<2020-05-29>
    
60.   '通过form_load启动调用了 command2 命令，如将form_load的内容放入一个命令Command3中，
    
61.   '即Command3可以调用command2 命令
    
62. '==================================================
    
63. 
    
64.    '寻找按钮句柄
    
65.     '
    
66.     '具体代码内容根据软件的结构不同而不同,参考SPY++中目标软件的结构图
    
67.     '
    
68.     Dim hTmp As Long
    
69.    
    
70. 
    
71.     hTmp = FindWindow(vbNullString, "12345") '    12345 为窗体名字' findwindow(vbnullstring,"窗体名字")
    
72.    
    
73.     If hTmp <> 0 Then
    
74.          hDest = FindWindowEx(hTmp, 0, vbNullString, "Command2")     
    
75.          End If
    
76.    If hDest <> 0 Then
    
77.         SendClick hDest, 10, 10              '
    
78.     Else
    
79.         MsgBox "还未找到句柄!"
    
80.     End If
    
81. End Sub
    
82. Private Function SendClick(hwnd As Long, mX As Long, mY As Long)
    
83.     '发送点击消息
    
84.     Dim I As Long
    
85.     I = PostMessage(hwnd, WM_LBUTTONDOWN, 0, (mX And &HFFFF) + (mY And &HFFFF) * &H10000)
    
86.     I = PostMessage(hwnd, WM_LBUTTONUP, 0, (mX And &HFFFF) + (mY And &HFFFF) * &H10000)
    
87. End Function

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _<br />      ByVal lpClassName As String, _<br />      ByVal lpWindowName As String) As Long<br /> Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _<br />      ByVal hWnd1 As Long, _<br />      ByVal hWnd2 As Long, _<br />      ByVal lpsz1 As String, _<br />      ByVal lpsz2 As String) As Long<br /> Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _<br />      ByVal hwnd As Long, _<br />      ByVal wMsg As Long, _<br />      ByVal wParam As Long, _<br />      ByVal lParam As Long) As Long<br /> Private Const WM_LBUTTONDOWN As Long = &H201<br /> Private Const WM_LBUTTONUP As Long = &H202<br /> Dim hDest As Long           '目标按钮句柄<br /> Private Sub Command1_Click()<br /> On Error GoTo ErrHandler<br /> <br />     <br />     <br /> '''连接cad<br />     Dim acadapp As Object  'AcadApplication<br />     Dim Thisdrawing As Object  'AcadDocument<br />    ' Dim thisDrawing As Object<br />     Set acadapp = GetObject(, "<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.Application")<br />     If Err Then<br />         Err.Clear<br />         Set acadapp = CreateObject("AutoCAD.Application")<br />         If Err Then<br />             MsgBox Err.Description<br />             End<br />             Exit Sub<br />         End If<br />     End If<br />     acadapp.Visible = True<br />     Set Thisdrawing = acadapp.ActiveDocument<br />     Thisdrawing.SendCommand "TEST" & vbCr '应该改进cad程序运行成功应该将这些数据从库中删除<br /> <br /> ErrExit:<br />     <br />     Exit Sub<br />     <br /> ErrHandler:<br />     MsgBox "运行时发生意外，请检查AutoCAD文件是否打开!", vbCritical, "提示"<br />     GoTo ErrExit<br /> End Sub<br /> Private Sub Command2_Click()<br /> MsgBox "测试怎么样?"<br /> End Sub<br /> Private Sub Command3_Click()'==================================================<br /> '时间长了,加个备注<2020-05-29><br /> '1.  form_load的内容<示例中调用command2>,同理 也可实现调用Command1<br /> '2.  如调用command1的内容<即lisp>,也就是lisp命令可以前置 ,再运行其他vb内容<br /> '==================================================<br /> End Sub<br /> Private Sub Form_Load()<br /> '==================================================<br /> '时间长了,加个备注<2020-05-29><br />   '通过form_load启动调用了 command2 命令，如将form_load的内容放入一个命令Command3中，<br />   '即Command3可以调用command2 命令<br /> '==================================================<br /> <br />    '寻找按钮句柄<br />     '<br />     '具体代码内容根据软件的结构不同而不同,参考SPY++中目标软件的结构图<br />     '<br />     Dim hTmp As Long<br />     <br /> <br />     hTmp = FindWindow(vbNullString, "12345") '    12345 为窗体名字' findwindow(vbnullstring,"窗体名字")<br />     <br />     If hTmp <> 0 Then<br />          hDest = FindWindowEx(hTmp, 0, vbNullString, "Command2")     <br />          End If<br />    If hDest <> 0 Then<br />         SendClick hDest, 10, 10              '<br />     Else<br />         MsgBox "还未找到句柄!"<br />     End If<br /> End Sub<br /> Private Function SendClick(hwnd As Long, mX As Long, mY As Long)<br />     '发送点击消息<br />     Dim I As Long<br />     I = PostMessage(hwnd, WM_LBUTTONDOWN, 0, (mX And &HFFFF) + (mY And &HFFFF) * &H10000)<br />     I = PostMessage(hwnd, WM_LBUTTONUP, 0, (mX And &HFFFF) + (mY And &HFFFF) * &H10000)<br /> End Function

zzyong00

Appactivate acadapp.Caption

Kye

zzyong00 发表于 2017-9-11 12:58
Appactivate acadapp.Caption

阿勇老师的东西很很高端，是不是调用CAD窗口至当前？请阿勇老师给一个示例链接 谢谢

最初想实现在CAD中调用任务栏中的exe窗口至前台，未实现，只好用taskkill 关闭进程，重启命令

主楼的程序是想分享下 在同一个窗口下，一个命令调用另外一个命令的示例，或许论坛上有，不过没有看到，这个示例程序还是有点用处.比如sendcommand lisp程序只能放在最后，如果在lisp程序后面还想再做点什么之类就可以用这个调用下 呵呵

vbcad

zzyong00说的是对的
用CAD2006作的实验，代码如下：
'将cad激活到当前
Private Sub Command1_Click()
Appactivate "AutoCAD"
End Sub

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢