AutoCAD界面移植到VB.net应用程序窗体中

最近因为需要将AutoCAD界面移植到VB.net应用程序窗体中，琢磨、搜索了很久，终于搞清楚，贴出来。。。

1.首先涉及两个按钮，第一个是启动CAD进程，第二个是打开图形界面

2.第一个按钮的进程启动事件：

Private Sub txcl_qdcad_ItemClick(ByVal sender As System.Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles txcl_qdcad.ItemClick
Dim runThread As Thread
runThread = New Thread(AddressOf qidongcad)

If txcl_qdcad.Caption = "启动AutoCad" Then

ztl_text.Caption = "温馨提示：若长时间无法启动，请线手动打开AutoCAD后重新启动..."
ztl_text.Refresh()
txcl_qdcad.Caption = "中止AutoCad"
runThread.Start()

ElseIf txcl_qdcad.Caption = "中止AutoCad" Then

txcl_qdcad.Caption = "启动AutoCad"
runThread.Abort()
ztl_text.Caption = "中止AutoCad成功"
ztl_text.Refresh()
End If

End Sub

’----线程

Private Sub qidongcad()
'SplashScreenManager.ShowWaitForm()
'SplitContainerControl1.Visible = False
'ChartControl_gxzx.Visible = False
'Dim acadApp As Autodesk.AutoCAD.Interop.AcadApplication
Try

'-------------------------------------------------
'启动CAD

'－－－－－－－－－－－－－－－－－－－－－－－－－－－
Try
acadApp = GetObject(, "AutoCAD.Application")

acadApp.Visible = False
Catch ex As Exception
Try
acadApp = CreateObject("AutoCAD.Application")
Catch dd As Exception
'SplashScreenManager.CloseWaitForm()
MsgBox("无法启动AutoCAD！", vbYes, "标题")
End Try
End Try
txcl_gbtxjm.Enabled = True
txsc_txsc.Enabled = True
txcl_qdcad.Enabled = False
ztl_text.Caption = "启动AutoCad成功"
Catch ex As Exception
txcl_qdcad.Enabled = True
'SplashScreenManager.CloseWaitForm()
MsgBox("未知错误，请尝试再次启动！", vbYes, "标题")
Exit Sub
End Try

'AppActivate(acadApp.Caption) '切换到CAD的界面为主体

End Sub

3.界面开启事件

Private Sub txcl_gbtxjm_ItemClick(ByVal sender As System.Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles txcl_gbtxjm.ItemClick
If txcl_gbtxjm.Caption = "打开图形界面" Then
SplashScreenManager.ShowWaitForm()
acadApp = GetObject(, "AutoCAD.Application")
lHwnd = GetParent(GetParent(acadApp.ActiveDocument.HWND)) '获得CAD窗体的句柄
If lHwnd = 0 Then Exit Sub

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

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

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

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

SetParent(lHwnd, SplitContainerControl1.Panel2.Handle)

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

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

'隐藏工具栏
HideTool()
txcl_qdcad.Caption = "启动AutoCad"
txcl_gbtxjm.Caption = "关闭图形界面"
txcl_kqgbmlh.Enabled = True
txcl_biaozhu.Enabled = True
ztl_text.Caption = "打开图形界面成功"
SplashScreenManager.CloseWaitForm()
ElseIf txcl_gbtxjm.Caption = "关闭图形界面" Then
If MsgBox("确认关闭图形窗口界面？", vbYesNo, "标题") = vbYes Then
On Error Resume Next
acadApp.Visible = False
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 = 1 'AcWindowState.acMax

'恢复隐藏的CAD标题栏
L = GetWindowLong(lHwnd, GWL_STYLE)
L = L Or (WS_CAPTION)
L = SetWindowLong(lHwnd, GWL_STYLE, L)
'恢复工具栏
For Each Menugroup In acadApp.MenuGroups
For Each Toolbar In Menugroup.Toolbars
If Toolbar IsNot Nothing Then
For ii = 0 To CadToolsxh - 1
Dim dqstr() As String
dqstr = Split(CadTools(ii), ",")
If Toolbar.Name = dqstr(0) Then
If dqstr(1).ToUpper = "TRUE" Then
Toolbar.Visible = True
Else
Toolbar.Visible = False
End If
Exit For
End If
Next
End If
Next Toolbar
Next Menugroup
acadApp.Quit()
acadApp = Nothing
ChartControl_gxzx.Visible = True
txcl_gbtxjm.Caption = "打开图形界面"
ztl_text.Caption = "关闭图形界面成功"
txcl_gbtxjm.Enabled = False
txsc_txsc.Enabled = False
txcl_qdcad.Enabled = True
txcl_kqgbmlh.Enabled = False
txcl_biaozhu.Enabled = False
End If
End If

End Sub

‘-------------子函数以及定义等

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 Object '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
Dim CadTools() As String
Dim CadToolsxh As Integer

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 HideTool() '隐藏/显示CAD工具栏
On Error Resume Next
Dim Menugroup As Object
Dim Toolbar As Object

CadToolsxh = 0
'----------隐藏
ReDim CadTools(1000)
For Each Menugroup In acadApp.MenuGroups
For Each Toolbar In Menugroup.Toolbars
CadTools(CadToolsxh) = Toolbar.Name & "," & Toolbar.Visible.ToString
CadToolsxh = CadToolsxh + 1
Toolbar.Visible = False
Next Toolbar
Next Menugroup

''-----------显示
'For Each Menugroup In acadApp.MenuGroups
' For Each Toolbar In Menugroup.Toolbars
' i = i + 1
' Toolbar.Visible = CadTools(i)
' Next Toolbar
'Next Menugroup

End Sub

最后结果如图所示：

AutoCAD界面移植到VB.net应用程序窗体中相关推荐

winform界面嵌入dwg图纸_完美解决窗体中预览DWG图形(C#版）
看到完美解决VB.NET窗体中预览DWG图形帖子后,用C#代码实现如下: class ViewDWG { struct BITMAPFILEHEADER { public short bfType; ...
调试JavaScript/VB Script脚本程序（ASP篇）
在文章调试JavaScript/VB Script脚本程序(Wscript篇)里面,有网友问我如何调试ASP里面的脚本程序,我不知道他问得是调试ASP网页里面的VBScript ASP代码,还是ASP ...
GUI Guider设计UI界面移植到STM32
GUI Guider设计UI界面移植到STM32 一.什么是GUI Guider 什么是 GUI-Guider? GUI Guider 是恩智浦为 LVGL 开发了一个上位机GUI 设计工具,可以通过 ...
调试JavaScript/VB Script脚本程序（IE篇）
JavaScript/VB Script脚本程序一般有两种执行方式,一种是嵌入在宿主程序里面执行,比如在IE浏览器里面执行:另外一种,在资源管理器里面双击执行(虽然还是通过另外一个程序解释执行,但是给 ...
C++ MFC界面读写USB HID设备数据程序
C++ MFC界面读写USB HID设备数据程序发一个简单易用的界面,用来对USB HID设备(比如说游戏手柄,控制面板等)读写数据,一般情况下面板上有一些LED,可以帮助我们测试读写是否正确.另外 ...
linux系统在硬盘上安装程序,怎么样用硬盘上的镜象文件来安装Linux系统？我都进入安装界面了，但是那个安装程序好像找不到那几个镜象文件，请指点...
怎么样用硬盘上的镜象文件来安装Linux系统?我都进入安装界面了,但是那个安装程序好像找不到那几个镜象文件,请指点光盘镜象文件名字为: 5.1-RELEASE-i386-disc1.iso 5.1- ...
高中计算机会考vb教程,高中信息技术VB会考上机程序题汇总
高中信息技术VB会考上机程序题汇总信息技术(选修) 程序题汇总 ☆输入2个数,实现2个数的互换: ☆求S=1-2+3-4 +N a=text1.text N=text1.text b=text2.t ...
VB 感染EXE 程序病毒源码
使大家清楚认识病毒程序的运行机理,提高自身程序的抵抗力. 说明: 1.本代码目前仅是实验模型,给新手讲解原理之用,不会失控,绝对安全. 2.本代码仅实现了感染EXE的功能,其他的功能还须你自己加入. ...
[转载]VB网络聊天程序的开发(1)
原文地址:VB网络聊天程序的开发(1)作者:VB源码博客互联网已经成为现代社会生活中非常普及的一项事务.在互联网上可以查询信息.电子购物,还可以进行网络聊天.本博将从今天起,具体的计解一下利用VB开 ...

AutoCAD界面移植到VB.net应用程序窗体中

AutoCAD界面移植到VB.net应用程序窗体中相关推荐

最新文章

热门文章