[求助]如何在VB环境下获取AutoCAD的Text（文本对象），请教各位啦
我现在需要完成一个应用程序，其中一个步骤是从中获取数据，开发是VB这个步骤要实现：当我点击CAD图形中的Text（实际上是图斑的编号，都是数字）的时候，自动获取它并放到一个VB文本框中。最近一周一直在学习ActiveX方面的知识，但是自己没有这方面的书籍，网上的东西零零碎碎地，AutoCAD的developer help也看得头大，现在比较急用，希望能有人帮忙写这段代码或者给点参考代码也好。这里先感谢了
这个是我的代码，希望能有人帮帮忙啦
Dim sset As Object
Dim utilobj As Object
Dim pnt
Dim temppoint(0 To 2) As Double
Dim pointl
Dim strsqltext As String
'错误陷阱
On Error GoTo error_show
enablecommandbuttons (False)
'状态栏提示信息
lblstatus.Caption = "在AUTOCAD窗口中选择一个对象"
'激活AUTOCAD程序窗口
Set utilobj = objacad.ActiveDocument.Utility
'在AUTOCAD命令窗口显示信息
pnt = utilobj.GetPoint(, "在图形窗口中选择一个对象:")
temppoint(0) = pnt(0)
temppoint(1) = pnt(1)
temppoint(2) = pnt(2)
pointl = utilobj.TranslateCoordinates(temppoint, 0, 1, 0)
point(0) = pointl(0)
point(1) = pointl(2)
point(2) = pointl(2)
lblstatus.Caption = ""
'出错处理
On Error Resume Next
'如果存在
If Not IsNull(objdoc.sesectionsets.Item("ss1")) Then
Set sset = objdoc.SelectionSets.Item("ss1")
sset.Delete
End If
Set sset = objdoc.SelectionSets.add("ss1")
'出错处理
On Error GoTo error_show
Call sset.SelectAtPoint(point)
'检查是否选择了一个对象
If sset.Count = 1 Then
If StrComp(sset(0).EntityName, "acdbblockreferrence", 1) = 0 Then
'链接到数据库
strHandle1 = sset(0).Handle
strsqltext = "seleCt * from sheet1 where handle='" & Trim(strHandle1) & "'"
Data1.RecordSource = strsqltext
Data1.Refresh
'数据库中有相关信息
If checkallfilled Then
cmdeditrecord.Enabled = True '按钮状态###################
cmddeleterecord.Enabled = True
'没有相关信息
Else
MsgBox "记录不存在，请添加相关信息"
cmdaddrecord.Enabled = True
clearsql
End If
Else
'没有选择对象
If sset.Count = 0 Then
Form1.ide
MsgBox "未选中图块"
End If
End If
Exit Sub
'错误陷阱
error_show
MsgBox Err.Description
Exit Sub
End Sub
Private Sub cmdstart_Click()
' 运行AUTOCAD
startautocad
'设定按钮状态##############
cmdstart.Enabled = False
'cmdclearsql.Enabled = True
cmdshowrecord.Enabled = True
cmdlink.Enabled = True
cmdhighlight.Enabled = True
End Sub
Private Sub startautocad()
'设定文件名目录变量
Dim dwgname As String
'错误陷阱
On Error Resume Next
'设定AUTOCAD对象
Set objacad = GetObject(, "autocad.application")
If Err Then
'打开autocad程序
Set objacad = CreateObject("autocad.application")
Err.Clear
End If
If Right(App.Path, 1) = "\" Then
dwgname = App.Path & "虹口02.dwg"
Else
dwgname = App.Path & "\虹口02.dwg"
End If
Set objdoc = objacad.ActiveDocument
sysvarname = "osmode"
sysvardata = objdoc.GetVariable(sysvarname)
osMode = CInt(sysvardata)
objdoc.SetVariable sysvarname, 0
sysvarname = "sdi"
sysvardata = objdoc.GetVariable(sysvarname)
sdimode = CInt(sysvardata)
objdoc.SetVariable sysvarname, 1
If objdoc.FullNamedwgname Then
objdoc.Open dwgname
End If
objacad.Visible = True
End Sub
Private Sub txtUse_click()
MsgBox "this box cannot be edited"
End Sub
Private Function checkallfilled() As Boolean
Dim chkstr As String
checkallfilled = False
chkstr = Trim(txtLSH.Text & txtName.Text & txtPzwh.Text & txtPzwh2.Text & txtDate.Text & txtPzwh3.Text & txtPosition.Text)
If (chkstr"") Then
checkallfilled = True
End If
End Function
'获取文件句柄
Private Function gethandle() As String
Dim utilobj As Object
Dim pnt
Dim temppoint(0 To 2) As Double
Dim point(0 To 2) As Double
Dim pointl
Dim sset As Object
'出错处理
On Error GoTo error_gethandle
Set utilobj = objacad.ActiveDocument.Utility
pnt = utilobj.GetPoint(, "选择一个CAD对象连接记录:")
temppoint(0) = pnt(0)
temppoint(1) = pnt(1)
temppoint(2) = pnt(2)
pointl = utilobj.TranslateCoordinates(temppoint, 0, 1, 0)
point(0) = pointl(0)
point(1) = pointl(1)
point(2) = pointl(2)
lblstatus.Caption = ""
'获取选择集对象
Set sset = objacad.ActiveDocument.SelectionSets.add("ss1")
Call sset.SelectAtPoint(point)
If sset.Count = 1 Then
If StrComp(sset(0).EntityName, "acdbblockreference", 1) = 0 Then
gethandle = sset(0).Handle
Else
MsgBox "没有图块被选中"
gethandle = ""
End If
Else
If sset.Count = 0 Then
Form1.Hide
MsgBox "没有图块被选中"
Form1.Show
End If
If sset.Count > 1 Then
MsgBox "选中图块超过一个"
End If
gethandle = ""
End If
Exit Function
选择单个对象要以使用GetEntity方法，而判断选中对象是否为文本可以使用ObjectName属性来判断是否为“AcDbText”，获取文本的内容可以使用TextString属性。
谢谢您的提示，我用您的方法试试看
页:
[1]