|
|
买了一本《 二次开发》，久仰版主大名，学习中的问题，请版主百忙之中帮忙看看这是怎么回事。
为什么我在使用《cad 二次开发教程》里16章的16.1.5在cad和vb窗口之间切换焦点实例时可以切换到cad窗口，但是获取cad中的一个坐标后不能返回vba窗体。
窗体名称：FormMain
标准模块：
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9
Public Function ForceForegroundWindow(ByVal hWnd As Long) As Boolean
Dim ThreadID1 As Long
Dim ThreadID2 As Long
Dim nRet As Long
'如果指定的窗体已经在前台，不作任何操作
If hWnd = GetForegroundWindow() Then
ForceForegroundWindow = True
Else
'获得指定窗体相关的线程和当前前台窗口所在的线程
ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
ThreadID2 = GetWindowThreadProcessId(hWnd, ByVal 0&)
'通过共享输入状态，两个线程分享当前窗口
If ThreadID1 ThreadID2 Then
Call AttachThreadInput(ThreadID1, ThreadID2, True)
nRet = SetForegroundWindow(hWnd)
Call AttachThreadInput(ThreadID1, ThreadID2, False)
Else
nRet = SetForegroundWindow(hWnd)
End If
'恢复和重画
If IsIconic(hWnd) Then
Call ShowWindow(hWnd, SW_RESTORE)
Else
Call ShowWindow(hWnd, SW_SHOW)
End If
'精确地返回函数执行结果
ForceForegroundWindow = CBool(nRet)
End If
End Function
vb程序中使用：
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application") '获得应用程序进程（返回文件中的 ActiveX 对象的引用。）(这是在autocad程序已经打开的情况下使用的)
If Err Then '如果获得应用程序进程出错
Err.Clear '清除 Err 对象的所有属性设置。
Set acadApp = CreateObject("AutoCAD.Application") '创建应用程序进程（创建并返回一个对 ActiveX 对象的引用。这是在autocad程序没打开的情况下使用的）
If Err Then End '如果还出错就结束本过程，表示未安装cad
End If
acadApp.Visible = True '使cad程序可见
Dim pt As Variant
ForceForegroundWindow acadApp.hWnd
pt = acadApp.ActiveDocument.Utility.GetPoint(, "拾取一点:")
ForceForegroundWindow FormMain.hWnd'这里不能返回到vb窗口，但是下面的文本框里可以获得坐标？？？
Text1.Text = "X" & pt(0) & " Y" & pt(1) & " Z" & pt(2)
|
|
置顶卡
