AutoCAD VBA 非模态窗体焦点处理

引用的win32 api

Option Explicit
Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (G As GUID) As Long
Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (G As GUID, ByVal str As String, ByVal cchMax As Long) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Function GetGUID() As String
    Dim G As GUID
    Dim S As String
    S = String(76, vbNullChar)
    CoCreateGuid G
    StringFromGUID2 G, S, Len(S)
    S = StrConv(S, vbFromUnicode)
    GetGUID = S
End Function

Public Function GetUserFormHandle(ByVal UF As Object)
    Dim S As String
    Dim OrigCaption As String
    S = GetGUID()
    OrigCaption = UF.Caption
    UF.Caption = S
    GetUserFormHandle = FindWindow(vbNullString, S)
    UF.Caption = OrigCaption
End Function

窗体里面的处理

 

Option Explicit
Private CurUserFormHwnd As Long
Private Sub CommandButton1_Click()
    Me.Hide
    VBA.AppActivate ThisDrawing.Application.Caption
    Dim pt As Variant
    pt = ThisDrawing.Utility.GetPoint(, "pick a point")
    ThisDrawing.ModelSpace.AddCircle pt, VBA.Val(Me.TextBox1.Text)
    ThisDrawing.Regen acActiveViewport
    Me.show 0
    Win32Api.SetParent CurUserFormHwnd, CLng(AcadApplication.hwnd)
End Sub

Private Sub UserForm_Initialize()
    CurUserFormHwnd = Win32Api.GetUserFormHandle(Me)
    Win32Api.SetParent CurUserFormHwnd, CLng(AcadApplication.hwnd)
End Sub

视频效果

https://www.bilibili.com/video/BV1jE421P7tP/