[VBA程序]：vb控制acad

god

我通过以下代码在vb6中调用acad，原来用    AppActivate "AutoCAD" 来激活acad使它置于其他窗口前面，没出问题，近来不行了，执行到AppActivate "AutoCAD" 就报错，说是非法函数，还不知道是什么原因。后来改成下面这个就可以了，有没有别的办法激活acad呢？并且做到与acad版本无关？

AcadApp.Visible = True    为什么做不到将autocad在前台显示？


On Error Resume Next
    AppActivate "AutoCAD 2002"
    AppActivate "AutoCAD 2004"
    AppActivate "AutoCAD 2005"
    On Error GoTo 0

2. 
   
3.     Public AcadApp As Object  '//应用程序对象声明
   
4.     Public AcadPre As Object  '//属性设置对象声明
   
5.     Public AcadDoc As Object '//CAD文档对象声明
   
6.     Public AcadMod As Object  '//模型空间对象声明
   
7.     Public AcadPap As Object  '//图纸空间对象声明
   
8.    
   
9.    
   
10. '    Public AcadApp As AutoCAD.AcadApplication '建立Application?象
    
11. '    Public AcadDoc As AcadDocument '建立Document?象
    
12. '    Public AcadMod As AcadModelSpace '建立Model Space ?象
    
13. 
    
14.    On Error Resume Next
    
15.     Set AcadApp = GetObject(, "autocad.application")   '若AutoCad已启动 , 则直接得到
    
16.     If Err Then
    
17.         Err.Clear
    
18.         Set AcadApp = CreateObject("autocad.application")   '若AutoCad未启动，则运行它
    
19.         If Err Then
    
20.             MsgBox Err.Description, , "错误"
    
21.             On Error GoTo 0
    
22.             Exit Sub
    
23.         End If
    
24.     End If
    
25.     On Error GoTo 0
    
26.    
    
27.     Set AcadApp = GetObject(, "AutoCAD.Application") '//自动启动autocad程序
    
28.     AcadApp.Visible = True '//将autocad在前台显示
    
29.     Set AcadPre = AcadApp.Preferences '//属性设置对象初始化
    
30.     Set AcadDoc = AcadApp.ActiveDocument '//文档对象初始化
    
31.     Set AcadMod = AcadDoc.ModelSpace '//模型空间对象初始化
    
32.     Set AcadPap = AcadDoc.PaperSpace '//图纸空间对象初始化
    
33.    
    
34.     On Error Resume Next
    
35.     AppActivate "AutoCAD 2002"
    
36.     AppActivate "AutoCAD 2004"
    
37.     AppActivate "AutoCAD 2005"
    
38.     On Error GoTo 0
    
39. 
    

<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 />     <br />     <br /> '    Public AcadApp As AutoCAD.AcadApplication '建立Application?象<br /> '    Public AcadDoc As AcadDocument '建立Document?象<br /> '    Public AcadMod As AcadModelSpace '建立Model Space ?象<br /> <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 />     <br />     On Error Resume Next<br />     AppActivate "AutoCAD 2002"<br />     AppActivate "AutoCAD 2004"<br />     AppActivate "AutoCAD 2005"<br />     On Error GoTo 0<br /> <br />

雪山飞狐(lzh)

判断AcadApp的版本属性

god

怎么做呢？ 比如AcadApp.Version的返回值是  一、 15.06      二、    16.0s (LMS Tech)     ，分别是2002和2004。

雪山飞狐(lzh)

或者直接调用Api函数，把Acadapp的句柄传过去

god

太高深了，我很菜的，你又说得这么笼统，不知道怎么做。
用哪个api函数？

雪山飞狐(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
Public AcadApp As Object

Private Sub Form_Click()
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")   '若AutoCad已启动 , 则直接得到
    If Err Then
        Err.Clear
        Set AcadApp = CreateObject("AutoCAD.Application")   '若AutoCad未启动，则运行它
        If Err Then
            MsgBox Err.Description, , "错误"
            On Error GoTo 0
            Exit Sub
        End If
    End If
    AcadApp.WindowState = 3
    SetWindowPos AcadApp.hwnd, HWND_TOP, 0, 0, 0, 0, SWP_FRameCHANGED Or SWP_NOMOVE Or SWP_NOSIZE

End Sub

god

你真高。怎么这么厉害阿！！

这个语句里 Set AcadApp = GetObject(, "AutoCAD.Application")，引号里的字符是怎么确定的，如果我要获得某个软件是否运行的信息，比如写字板或其它软件，怎么知道Application前面该用什么字符串？

雪山飞狐(lzh)

GetObject只能获取ActiveX对象，即提供了ActiveX接口的应用程序
如果是其他软件可能可以调用Api实现（我没试过）

god

你是说提供了ActiveX接口的应用程序，会在使用说明里说明这一点吗？如果没说明就没法知道Application前面该用什么字符串？

怎么你怎么快就知道有人回帖了？该怎么设置？

雪山飞狐(lzh)

最初由 god 发布
[B]你是说提供了ActiveX接口的应用程序，会在使用说明里说明这一点吗？如果没说明就没法知道Application前面该用什么字符串？

怎么你怎么快就知道有人回帖了？该怎么设置？ [/B]

^_^，因为偶是无业游民

god

还在上学？

雪山飞狐(lzh)

打住了，再贴就有水贴的嫌疑了，我的工作因为太悠闲，天天都挂在网上的

god

http://www.xdcad.net/forum/showt ... d=551299#post551299

这个贴子里说的直接浏览数据库是什么意思？vb能做到吗？

雪山飞狐(lzh)

Arx的方法和VBA有很大差别，直接浏览数据库在VBA来说是底层操作，不可见，反而用选择集＋过滤器还快一些

god

我用下面这段vb6代码的 aa过程 按物件的EntityType属性来判断是否为文字，取出图档中所有文字。
但是执行效率非常低，一秒钟只能检查几十个实体，是什么原因？能更快吗？vb的遍历效率这么低吗？
效率低的是这两个语句
Set retObj = .Item(i)  
a = retObj.EntityType

2. 
   
3.    Public AcadApp As Object  '//应用程序对象声明
   
4.     Public AcadPre As Object  '//属性设置对象声明
   
5.     Public AcadDoc As Object '//CAD文档对象声明
   
6.     Public AcadMod As Object  '//模型空间对象声明
   
7.     Public AcadPap As Object  '//图纸空间对象声明
   
8.    
   
9.    
   
10. '    Public AcadApp As AutoCAD.AcadApplication '建立Application?象
    
11. '    Public AcadDoc As AcadDocument '建立Document?象
    
12. '    Public AcadMod As AcadModelSpace '建立Model Space ?象
    
13. 
    
14. Public Sub DeclareAcad()
    
15.     On Error Resume Next
    
16.     Set AcadApp = GetObject(, "autocad.application")   '若AutoCad已启动 , 则直接得到
    
17.     If Err Then
    
18.          Err.Clear
    
19.         Set AcadApp = CreateObject("autocad.application")   '若AutoCad未启动，则运行它
    
20.         If Err Then
    
21.             MsgBox Err.Description, , "错误"
    
22.             On Error GoTo 0
    
23.             Exit Sub
    
24.         End If
    
25.     End If
    
26.     On Error GoTo 0
    
27.    
    
28.     Set AcadApp = GetObject(, "AutoCAD.Application") '//自动启动autocad程序
    
29.     AcadApp.Visible = True '//将autocad在前台显示
    
30.     Set AcadPre = AcadApp.Preferences '//属性设置对象初始化
    
31.     Set AcadDoc = AcadApp.ActiveDocument '//文档对象初始化
    
32.     Set AcadMod = AcadDoc.ModelSpace '//模型空间对象初始化
    
33.     Set AcadPap = AcadDoc.PaperSpace '//图纸空间对象初始化
    
34.    
    
35.     On Error Resume Next
    
36.     AppActivate "AutoCAD"
    
37.     AppActivate "AutoCAD 2002"
    
38.     AppActivate "AutoCAD 2004"
    
39.     AppActivate "AutoCAD 2005"
    
40.     On Error GoTo 0
    
41. 
    
42. End Sub
    
43. 
    
44. 
    
45. Public Sub aa()
    
46. qw = Timer
    
47. Dim i As Integer
    
48. Dim retObj As Object
    
49. Form1.StringList.Clear
    
50. With AcadApp.ActiveDocument.ModelSpace
    
51.     For i = 0 To .Count - 1 Step 1
    
52.         Set retObj = .Item(i)
    
53.         a = retObj.EntityType
    
54.         If a = acText Or a = acMtext Then
    
55.             Form1.StringList.AddItem retObj.TextString, 0
    
56.         End If
    
57.     Next i
    
58. End With
    
59. Form1.StringList.Refresh
    
60. Debug.Print Timer - qw
    
61. End Sub
    
62. 
    

<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 />     <br />     <br /> '    Public AcadApp As AutoCAD.AcadApplication '建立Application?象<br /> '    Public AcadDoc As AcadDocument '建立Document?象<br /> '    Public AcadMod As AcadModelSpace '建立Model Space ?象<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 />     <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 /> <br /> End Sub<br /> <br /> <br /> Public Sub aa()<br /> qw = Timer<br /> Dim i As Integer<br /> Dim retObj As Object<br /> Form1.StringList.Clear<br /> With AcadApp.ActiveDocument.ModelSpace<br />     For i = 0 To .Count - 1 Step 1<br />         Set retObj = .Item(i)<br />         a = retObj.EntityType<br />         If a = acText Or a = acMtext Then<br />             Form1.StringList.AddItem retObj.TextString, 0<br />         End If<br />     Next i<br /> End With<br /> Form1.StringList.Refresh<br /> Debug.Print Timer - qw<br /> End Sub<br /> <br />