[求助]再次提问，关于VB中获取CAD文本

Lostvivi · 发表于 2007-5-4 16:53:00

这是我发的原贴http://bbs.mjtd.com/forum.php?mod=viewthread&tid=59890，感谢明总！！（看论坛大家都这样叫）
原贴里面是我在一本书上抄的一段代码（实际上我也没全看明白，接触CAD的VB开发才几天，很多东西都不是很明白）
明总提示后我参照CAD开发帮助文档自己写了一段代码，还是有错，再次拜托高手帮忙修改或者提示下啦，真的很急用。
（我要实现的功能，点击command后切换到CAD窗口，提示点选一个单行文本，然后获取该文本的textstring赋给一个VB的文本框）

Dim acadApp As .AcadApplication
Dim AcadDoc As AcadDocument

Private Sub Command1_Click()
StartAcad
Dim OBJdoc As AcadText
Dim ptPick As Variant
Set acadApp = New autocad.AcadApplication
Set AcadDoc = acadApp.ActiveDocument
AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"
Text1.Text = OBJdoc.TextString
End Sub
Sub StartAcad()
Dim acadApp As AcadApplication
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application.16")
If Err Then
      Err.Clear
      Set acadApp = CreateObject("AutoCAD.Application.16")
      If Err Then
         MsgBox Err.Description
         Exit Sub
      End If
End If
MsgBox "Now running " + acadApp.Name + " version " + acadApp.Version
End Sub

Lostvivi · 发表于 2007-5-4 17:02:00

同一个问题发两个帖子不知道是否违规？
真的是急用这段代码，而且我想这是一个很简单的任务吧（对于已经入门的人来说）。希望有能力帮忙的不吝赐教。

StartMe · 发表于 2007-5-4 22:22:00

刚刚看到，这样试试：
Dim acadApp As AutoCAD.AcadApplication
Dim AcadDoc As AcadDocument
Private Sub Command1_Click()
'隐藏自身窗体，以把控制权交给CAD
Me.Hide
StartAcad
‘激活CAD窗体进行操作
AppActivate (acadApp.Caption)
Dim OBJdoc As AcadText
Dim ptPick As Variant
Set AcadDoc = acadApp.ActiveDocument
AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"
Text1.Text = OBJdoc.TextString
'重新显示自身
Me.Show
End Sub
Sub StartAcad()
Dim acadApp As AcadApplication’已经定义为模块级变量了，这句必须去掉！
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application.16")
If Err Then
      Err.Clear
      Set acadApp = CreateObject("AutoCAD.Application.16")
      If Err Then
         MsgBox Err.Description
         Exit Sub
      End If
End If
MsgBox "Now running " + acadApp.Name + " version " + acadApp.Version
End Sub

StartMe · 发表于 2007-5-4 22:29:00

再优化一下,声明API，使自身窗体置前:
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
在Me.show后面加上一句：
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
这样的易用性更好些。