将AutoCAD窗体嵌入到VB.NET窗体内 - wei855198的博客

作者在 2010-06-07 17:01:37 发布以下内容

本例使用API函数，将AutoCAD窗体嵌入到VB.NET的窗体内。测试环境：VB2008Express、AutoCAD2008

借鉴来源：www.mjtd.com

注意：API函数从VB6转到VB.NET，应将原long类型的声明改成integer.同为32位bit；将any类型改为object；将需要按地址传递的变量前加byref；

代码如下：

Public Class Form1
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Integer, ByVal hWndNewParent As Integer) As Integer
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Integer) As Integer

    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
    Private Declare Function SetWindowPos Lib "user32" _
    (ByVal hwnd As Integer, ByVal hwndInsertAfter As Integer, ByVal x As Integer, _
    ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

    Private Structure RECT
        Dim Left As Integer
        Dim Top As Integer
        Dim Right As Integer
        Dim Bottom As Integer
    End Structure

    Private lHwnd As Integer    '保存ACAD应用程序的窗口句柄

    Private lState As Integer        '保存ACAD的初始窗口状态

    Private r As RECT       '保存ACAD的初始窗口位置

    Private acadApp As Autodesk.AutoCAD.Interop.AcadApplication

    '下面这段代码用来设置CAD窗体的图标
    '------------------------------------------------------------------------------------------------------------------------
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
          (ByVal hInst As Integer, ByVal lpsz As String, ByVal un1 As Integer, _
          ByVal n1 As Integer, ByVal n2 As Integer, ByVal un2 As Integer) As Integer
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
              (ByVal Hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Object) As Integer
    Private Const WM_SETICON = &H80
    Private Const IMAGE_ICON = 1
    Private Const LR_LOADFROMFILE = &H10

    Public Sub SetIcon()
        Dim hIcon As Integer
        'FileName 图标文件, Hwnd  ACAD应用程序的句柄
        hIcon = LoadImage(0%, "E:\图片\图标\Excel.ico", IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
        If hIcon <> 0 Then
            Call SendMessage(lHwnd, WM_SETICON, 0, hIcon)
        End If
    End Sub

    '------------------------------------------------------------------------------------------------------

    '下面的代码用于隐藏AutoCAD的标题栏

'---------------------------------------------------------------------------------

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
    Public Const GWL_STYLE = (-16)
    Public Const WS_CAPTION = &HC00000
    Public L As Integer
    '-----------------------------------------------------------------------------------

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        If lHwnd = 0 Then Exit Sub
        SetParent(lHwnd, 0)
        SetWindowPos(lHwnd, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, 0)
        acadApp.WindowState = lState
        acadApp = Nothing

        '恢复隐藏的CAD标题栏
        L = GetWindowLong(lHwnd, GWL_STYLE)
        L = L Or (WS_CAPTION)
        L = SetWindowLong(lHwnd, GWL_STYLE, L)
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        'Dim acadApp As Autodesk.AutoCAD.Interop.AcadApplication

        Try

            '-------------------------------------------------
            '启动CAD
            Try
                acadApp = GetObject(, "AutoCAD.Application")
                acadApp.Visible = True
            Catch ex As Exception
                Try
                    acadApp = CreateObject("AutoCAD.Application")
                Catch dd As Exception
                    MsgBox("不能启动AutoCAD,是否没有安装？")
                End Try

            End Try
            '－－－－－－－－－－－－－－－－－－－－－－－－－－－

            lHwnd = GetParent(GetParent(acadApp.ActiveDocument.HWND))   '获得CAD窗体的句柄
            If lHwnd = 0 Then Exit Sub

            lState = acadApp.WindowState
            acadApp.WindowState = 1     '设置ACAD的窗口状态为默认，用于保存窗口位置。

            GetWindowRect(lHwnd, r)     '保存窗体原来的位置及大小到变量r

            MsgBox(Me.Left & "," & Me.Right & "," & Me.Top & "," & Me.Bottom)

            SetParent(lHwnd, Me.Handle)     '设置CAD窗体的父窗体为当前VB窗框

            SetWindowPos(lHwnd, 0, 0, 0, Me.Width - 10, Me.Height - 10, 0)        '设置CAD窗体的大小及位置

            SetIcon()

            '隐藏CAD标题栏
            L = GetWindowLong(lHwnd, GWL_STYLE)
            L = L And Not (WS_CAPTION)
            L = SetWindowLong(lHwnd, GWL_STYLE, L)

        Catch ex As Exception
            MsgBox("未知错误")
        End Try
    End Sub

    '下面的语句用来在VB窗体进行大小调节的时候CAD窗体随之变化
    Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        SetWindowPos(lHwnd, 0, 0, 0, Me.Width - 10, Me.Height - 10, 0)

    End Sub

End Class