[VBA程序]：请问vb调用acad后，怎么切换回来？

god

我用vb编了一段在acad中选择多段线的代码，选择完后用    Form1.Show语句切换到程序，使程序置顶。在vb ide编辑环境中可以返回置顶，但把它编译成exe文件后执行就不能返回置顶，只是在任务栏的程序标签一闪一闪的，请问各位高人应该怎么处理？

2. 
   
3. 
   
4.     Public AcadApp As Object  '//应用程序对象声明
   
5.     Public AcadPre As Object  '//属性设置对象声明
   
6.     Public AcadDoc As Object '//CAD文档对象声明
   
7.     Public AcadMod As Object  '//模型空间对象声明
   
8.     Public AcadPap As Object  '//图纸空间对象声明
   
9.     Public AcadDocs As Object '//文档对象初始化
   
10.    
    
11. 
    
12. Public Sub DeclareAcad()
    
13.     On Error Resume Next
    
14.     Set AcadApp = GetObject(, "autocad.application")   '若AutoCad已启动 , 则直接得到
    
15.     If Err Then
    
16.         Err.Clear
    
17.         Set AcadApp = CreateObject("autocad.application")   '若AutoCad未启动，则运行它
    
18.         If Err Then
    
19.             MsgBox Err.Description, , "错误"
    
20.             On Error GoTo 0
    
21.             Exit Sub
    
22.         End If
    
23.     End If
    
24.     On Error GoTo 0
    
25.    
    
26.     Set AcadApp = GetObject(, "AutoCAD.Application") '//自动启动autocad程序
    
27.     AcadApp.Visible = True '//将autocad在前台显示
    
28.     Set AcadPre = AcadApp.Preferences '//属性设置对象初始化
    
29.     Set AcadDoc = AcadApp.ActiveDocument '//文档对象初始化
    
30.     Set AcadMod = AcadDoc.ModelSpace '//模型空间对象初始化
    
31.     Set AcadPap = AcadDoc.PaperSpace '//图纸空间对象初始化
    
32.     Set AcadDocs = AcadApp.Documents '//文档对象初始化
    
33.    
    
34.     On Error Resume Next
    
35.     AppActivate "AutoCAD"
    
36.     AppActivate "AutoCAD 2002"
    
37.     AppActivate "AutoCAD 2004"
    
38.     AppActivate "AutoCAD 2005"
    
39.     On Error GoTo 0
    
40. End Sub
    
41. 
    
42. Public Sub GetPolyline()
    
43. '得到多段线坐标
    
44. Call DeclareAcad
    
45. 
    
46.     Dim plineObj As Object
    
47.     Dim Pt As Variant
    
48.    
    
49.     AcadDoc.Utility.GetEntity plineObj, Pt, "选择多义线: "
    
50.    
    
51.     Form1.Show
    
52. End Sub
    

<br /> <br />     Public AcadApp As Object  '//应用程序对象声明<br />     Public AcadPre As Object  '//属性设置对象声明<br />     Public AcadDoc As Object '//CAD文档对象声明<br />     Public AcadMod As Object  '//模型空间对象声明<br />     Public AcadPap As Object  '//图纸空间对象声明<br />     Public AcadDocs As Object '//文档对象初始化<br />     <br /> <br /> Public Sub DeclareAcad()<br />     On Error Resume Next<br />     Set AcadApp = GetObject(, "autocad.application")   '若AutoCad已启动 , 则直接得到<br />     If Err Then<br />         Err.Clear<br />         Set AcadApp = CreateObject("autocad.application")   '若AutoCad未启动，则运行它<br />         If Err Then<br />             MsgBox Err.Description, , "错误"<br />             On Error GoTo 0<br />             Exit Sub<br />         End If<br />     End If<br />     On Error GoTo 0<br />     <br />     Set AcadApp = GetObject(, "AutoCAD.Application") '//自动启动autocad程序<br />     AcadApp.Visible = True '//将autocad在前台显示<br />     Set AcadPre = AcadApp.Preferences '//属性设置对象初始化<br />     Set AcadDoc = AcadApp.ActiveDocument '//文档对象初始化<br />     Set AcadMod = AcadDoc.ModelSpace '//模型空间对象初始化<br />     Set AcadPap = AcadDoc.PaperSpace '//图纸空间对象初始化<br />     Set AcadDocs = AcadApp.Documents '//文档对象初始化<br />     <br />     On Error Resume Next<br />     AppActivate "AutoCAD"<br />     AppActivate "AutoCAD 2002"<br />     AppActivate "AutoCAD 2004"<br />     AppActivate "AutoCAD 2005"<br />     On Error GoTo 0<br /> End Sub<br /> <br /> Public Sub GetPolyline()<br /> '得到多段线坐标<br /> Call DeclareAcad<br /> <br />     Dim plineObj As Object<br />     Dim Pt As Variant<br />     <br />     AcadDoc.Utility.GetEntity plineObj, Pt, "选择多义线: "<br />     <br />     Form1.Show<br /> End Sub<br />

雪山飞狐(lzh)

我这不会闪（2005＋VB6）
加上
AppActivate Me.Caption
试试

god

还是不行，现象和原来一样。你是用我给的代码调试的吗？

我记得以前在win98下没问题，现在winxp有的机子可以，有的不行，搞不懂。

雪山飞狐(lzh)

看看你的调用代码（完整一点的）

god

这是源代码。

怪了，我刚才把  GetPolyline模块的  Form1.Show 语句取消，只在form1的代码中加AppActivate Me.Caption，结果在vb ide环境中也不能切换回来了，现在怎么改都不行了。

雪山飞狐(lzh)

用Api函数SetWindowPos试试

雪山飞狐(lzh)

我这很正常，你再试试
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Const SWP_FRameCHANGED = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const HWND_TOP = 0

Private Sub Command1_Click()
Call GetPolyline
Me.WindowState = 0
Me.Show
SetWindowPos Me.hwnd, HWND_TOP, 0, 0, 0, 0, SWP_FRameCHANGED Or SWP_NOMOVE Or SWP_NOSIZE

'AppActivate Me.Caption
End Sub

god

用api也不行，怎么啦。不知道是不是我们的机子有问题，很多台都这样

雪山飞狐(lzh)

你为什么要在VB里做呢，VBA不好些麽？

god

因为计算用的是vb，有几千行代码，计算原始数据要从acad中取多段线坐标，所以有这个需要，现在数据是可以得到了，但是取了数据后不切换回程序，如果不明说，有些用户就不会用。没办法。

雪山飞狐(lzh)

在VB里做Dll，VBA里调用试试吧
几千行代码，有点恐怖，：）

god

又要学dll，太难为我了，恐怕没时间，要做的是太多了，光是解决这些小问题都要花不少时间，幸亏有你们，否则就死定了。

headbegger

有收获