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

Lostvivi

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


Dim acadApp As AutoCAD.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

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

StartMe

刚刚看到，这样试试：

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

再优化一下,声明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

这样的易用性更好些。

Lostvivi

谢谢StartMe，我用你的提示再做做。

Lostvivi

能够切换到CAD窗口，但是还有和我先前一样的错误出现。
错误锁定在这句“AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"”。
这句是否是书写格式的错误？

Lostvivi

提示为“AutoCAD主窗口不可见”

Lostvivi

调试发现程序并没有通过点选获得OBJdoc，因为objdoc.textstring仍然为空

StartMe

运行正常啊，没有错误。

StartMe

 

你再仔细检查一下是否程序中其它语句的影响，单就这几句是没错误的。

你单独运行这几句试试看。