[讨论]如何令autocad软件窗口能够出现在VB窗体中？

efan2000

现在的情况应该是AutoCAD的对象不能创建，可能安装了多个版本的ACAD。

该怎么办呢难哦

以前装过14，2000，2002，2004。现在只保留了2000，可能注册表没有清干净。
遇到这种情况怎么办呢？

efan2000

将AutoCAD.Application更改为AutoCAD.Application.15试试。如果不行，要清除注册表，重装ACAD了。

该怎么办呢难哦

还是不行！呵呵，看来什么时候我给重装系统再看看。
Set a = CreateObject("AutoCAD.Application")将这句改为
Set a = GetObject(, "AutoCAD.Application.15")再先加载ACAD2000
终于看到效果了！！很好，谢谢efan2000。

myfreemind

运行这个窗口吧,ef2000的代码一次就通过,没有问题的!

该怎么办呢难哦

在窗体中显示的是autocad全界面,而且窗体不足够大，就不能全部包含autocad界面。可以令autocad界面能正好缩放在给定的窗体内吗？或者也能令autocad界面能出现在某个控件里吗（比如picture,image之类的控件）？

efan2000

重新修改了一下，支持VB的窗体缩放时ACAD的窗口自动跟随缩放。

2. 
   
3. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
   
4. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
   
5. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
   
6. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   
7. 
   
8. Private Type RECT
   
9.     Left As Long
   
10.     Top As Long
    
11.     Right As Long
    
12.     Bottom As Long
    
13. End Type
    
14. 
    
15. Private acadApp As Object
    
16. Private lHwnd As Long '保存ACAD应用程序的窗口句柄
    
17. Private lState As Long '保存ACAD的初始窗口状态
    
18. Private r As RECT '保存ACAD的初始窗口位置
    
19. 
    
20. Private Sub Form_Load()
    
21.    
    
22.     On Error GoTo ErrTrap
    
23.     Set acadApp = GetObject(, "AutoCAD.Application")
    
24.     acadApp.Visible = True
    
25.     lHwnd = GetParent(GetParent(acadApp.Activedocument.hwnd))
    
26.     If lHwnd = 0 Then Exit Sub
    
27.     lState = acadApp.WindowState
    
28.     acadApp.WindowState = 1 '设置ACAD的窗口状态为默认，用于保存窗口位置。
    
29.     GetWindowRect lHwnd, r
    
30.     SetParent lHwnd, Form1.hwnd
    
31.     Form1.ScaleMode = vbPixels '将VB窗体默认的缇单位改为以像素为单位。
    
32.     SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0
    
33.     Exit Sub
    
34.    
    
35. ErrTrap:
    
36.     On Error GoTo 0
    
37. End Sub
    
38. 
    
39. Private Sub Form_Resize()
    
40.     SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0
    
41. End Sub
    
42. 
    
43. Private Sub Form_Unload(Cancel As Integer)
    
44.     If lHwnd = 0 Then Exit Sub
    
45.     SetParent lHwnd, 0
    
46.     SetWindowPos lHwnd, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, 0
    
47.     acadApp.WindowState = lState
    
48.     Set acadApp = Nothing
    
49. End Sub
    

<br /> Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long<br /> Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long<br /> Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long<br /> Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long<br /> <br /> Private Type RECT<br />     Left As Long<br />     Top As Long<br />     Right As Long<br />     Bottom As Long<br /> End Type<br /> <br /> Private acadApp As Object <br /> Private lHwnd As Long '保存ACAD应用程序的窗口句柄<br /> Private lState As Long '保存ACAD的初始窗口状态<br /> Private r As RECT '保存ACAD的初始窗口位置<br /> <br /> Private Sub Form_Load()<br />     <br />     On Error GoTo ErrTrap<br />     Set acadApp = GetObject(, "AutoCAD.Application")<br />     acadApp.Visible = True<br />     lHwnd = GetParent(GetParent(acadApp.Activedocument.hwnd))<br />     If lHwnd = 0 Then Exit Sub<br />     lState = acadApp.WindowState<br />     acadApp.WindowState = 1 '设置ACAD的窗口状态为默认，用于保存窗口位置。<br />     GetWindowRect lHwnd, r<br />     SetParent lHwnd, Form1.hwnd<br />     Form1.ScaleMode = vbPixels '将VB窗体默认的缇单位改为以像素为单位。<br />     SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0<br />     Exit Sub<br />     <br /> ErrTrap:<br />     On Error GoTo 0<br /> End Sub<br /> <br /> Private Sub Form_Resize()<br />     SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0<br /> End Sub<br /> <br /> Private Sub Form_Unload(Cancel As Integer)<br />     If lHwnd = 0 Then Exit Sub<br />     SetParent lHwnd, 0<br />     SetWindowPos lHwnd, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, 0<br />     acadApp.WindowState = lState<br />     Set acadApp = Nothing<br /> End Sub<br />

该怎么办呢难哦

efan真是高！！
API函数功能真的强大，这段代码对于想通过在VB窗体实现autocad编辑操作的朋友太有借鉴意义了！再次感谢efan斑竹！

iwzw

呵呵，版主高明！更进一步了！
还有一个问题就是，vb的窗体不能用鼠标拖动放大和缩小。

efan2000

不是不能，由于将ACAD的窗口尺寸设置为VB窗体客户区的大小，因而两个窗口的右下角位置几乎是一样的，所以拖动的时候可能真正的是拖动ACAD的窗口。
这种情况可以将ACAD的窗口尺寸设置的小一些。比如：宽度Form1.ScaleWidth-5，高度Form1.ScaleHeight-5，这样就不会重叠了。

变更下面的一句：
SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0
更改为：
SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth-5, Form1.ScaleHeight-5, 0