Lostvivi 发表于 2007-5-1 00:36:00

[求助]如何在VB环境下获取AutoCAD的Text（文本对象），请教各位啦

本帖最后由 作者 于 2007-5-1 0:54:49 编辑 <br /><br /> <p>我现在需要完成一个应用程序，其中一个步骤是从AutoCAD中获取数据，开发工具是VB</p><p>这个步骤要实现：当我点击CAD图形中的Text（实际上是图斑的编号，都是数字）的时候，自动获取它并放到一个VB文本框中。最近一周一直在学习ActiveX方面的知识，但是自己没有这方面的书籍，网上的东西零零碎碎地，AutoCAD的developer help也看得头大，现在比较急用，希望能有人帮忙写这段代码或者给点参考代码也好。这里先感谢了</p>

Lostvivi 发表于 2007-5-2 01:30:00

这个是我的代码，希望能有人帮帮忙啦<br/>Dim sset As Object<br/>Dim utilobj As Object<br/>Dim pnt<br/>Dim temppoint(0 To 2) As Double<br/>Dim pointl<br/>Dim strsqltext As String<br/><br/>'错误陷阱<br/>On Error GoTo error_show<br/>enablecommandbuttons (False)<br/>'状态栏提示信息<br/>lblstatus.Caption = "在AUTOCAD窗口中选择一个对象"<br/>'激活AUTOCAD程序窗口<br/>Set utilobj = objacad.ActiveDocument.Utility<br/>'在AUTOCAD命令窗口显示信息<br/>pnt = utilobj.GetPoint(, "在图形窗口中选择一个对象:")<br/>temppoint(0) = pnt(0)<br/>temppoint(1) = pnt(1)<br/>temppoint(2) = pnt(2)<br/>pointl = utilobj.TranslateCoordinates(temppoint, 0, 1, 0)<br/>point(0) = pointl(0)<br/>point(1) = pointl(2)<br/>point(2) = pointl(2)<br/>lblstatus.Caption = ""<br/><br/>'出错处理<br/>On Error Resume Next<br/>'如果存在<br/>If Not IsNull(objdoc.sesectionsets.Item("ss1")) Then<br/>   Set sset = objdoc.SelectionSets.Item("ss1")<br/>   sset.Delete<br/>End If<br/><br/><br/>Set sset = objdoc.SelectionSets.add("ss1")<br/><br/><br/>'出错处理<br/>   On Error GoTo error_show<br/>   Call sset.SelectAtPoint(point)<br/>   <br/>   '检查是否选择了一个对象<br/>If sset.Count = 1 Then<br/>   If StrComp(sset(0).EntityName, "acdbblockreferrence", 1) = 0 Then<br/>   <br/>   '链接到数据库<br/>     strHandle1 = sset(0).Handle<br/>     strsqltext = "seleCt * from sheet1 where handle='" &amp; Trim(strHandle1) &amp; "'"<br/>     Data1.RecordSource = strsqltext<br/>     Data1.Refresh<br/>     <br/>     '数据库中有相关信息<br/>     If checkallfilled Then<br/>     cmdeditrecord.Enabled = True          '按钮状态###################<br/>     cmddeleterecord.Enabled = True<br/>     <br/>     '没有相关信息<br/>     Else<br/>        MsgBox "记录不存在，请添加相关信息"<br/>        cmdaddrecord.Enabled = True<br/>        clearsql<br/>        <br/>    End If<br/>Else<br/>'没有选择对象<br/>    If sset.Count = 0 Then<br/>      Form1.ide<br/>      MsgBox "未选中图块"<br/>    End If<br/>End If<br/>Exit Sub<br/><br/>'错误陷阱<br/>error_show<br/>   MsgBox Err.Description<br/>   Exit Sub<br/>End Sub<br/><br/>   <br/><br/>Private Sub cmdstart_Click()<br/>' 运行AUTOCAD<br/>    startautocad<br/>   '设定按钮状态##############<br/>   cmdstart.Enabled = False<br/>   'cmdclearsql.Enabled = True<br/>   cmdshowrecord.Enabled = True<br/>   cmdlink.Enabled = True<br/>   cmdhighlight.Enabled = True<br/>   <br/> End Sub<br/>Private Sub startautocad()<br/>'设定文件名目录变量<br/>  Dim dwgname As String<br/>  <br/>  '错误陷阱<br/>  On Error Resume Next<br/>  <br/>  '设定AUTOCAD对象<br/>       Set objacad = GetObject(, "autocad.application")<br/>       If Err Then<br/>       '打开autocad程序<br/>          <br/>          Set objacad = CreateObject("autocad.application")<br/>          Err.Clear<br/>        End If<br/>        <br/>        <br/>        If Right(App.Path, 1) = "\" Then<br/>           dwgname = App.Path &amp; "虹口02.dwg"<br/>        Else<br/>           dwgname = App.Path &amp; "\虹口02.dwg"<br/>        End If<br/>        <br/>        <br/>        Set objdoc = objacad.ActiveDocument<br/>        <br/>        <br/>        sysvarname = "osmode"<br/>        sysvardata = objdoc.GetVariable(sysvarname)<br/>        osMode = CInt(sysvardata)<br/>        objdoc.SetVariable sysvarname, 0<br/>        sysvarname = "sdi"<br/>        sysvardata = objdoc.GetVariable(sysvarname)<br/>        sdimode = CInt(sysvardata)<br/>        objdoc.SetVariable sysvarname, 1<br/>        <br/>        If objdoc.FullName &lt;&gt; dwgname Then<br/>            objdoc.Open dwgname<br/>        End If<br/>        objacad.Visible = True<br/>        <br/>End Sub<br/><br/><br/><br/><br/><br/><br/><br/><br/>Private Sub txtUse_click()<br/>    MsgBox "this box cannot be edited"<br/>End Sub<br/><br/><br/>Private Function checkallfilled() As Boolean<br/>      Dim chkstr As String<br/>      checkallfilled = False<br/>      chkstr = Trim(txtLSH.Text &amp; txtName.Text &amp; txtPzwh.Text &amp; txtPzwh2.Text &amp; txtDate.Text &amp; txtPzwh3.Text &amp; txtPosition.Text)<br/>      If (chkstr &lt;&gt; "") Then<br/>             checkallfilled = True<br/>      End If<br/>      End Function<br/><br/>'获取文件句柄<br/>Private Function gethandle() As String<br/><br/>     Dim utilobj As Object<br/>     Dim pnt<br/>     Dim temppoint(0 To 2) As Double<br/>     Dim point(0 To 2) As Double<br/>     Dim pointl<br/>     Dim sset As Object<br/>     <br/>     '出错处理<br/>     On Error GoTo error_gethandle<br/>     Set utilobj = objacad.ActiveDocument.Utility<br/>     pnt = utilobj.GetPoint(, "选择一个CAD对象连接记录:")<br/>     <br/>     <br/>   <br/>     temppoint(0) = pnt(0)<br/>     temppoint(1) = pnt(1)<br/>     temppoint(2) = pnt(2)<br/>     pointl = utilobj.TranslateCoordinates(temppoint, 0, 1, 0)<br/>     point(0) = pointl(0)<br/>     point(1) = pointl(1)<br/>     point(2) = pointl(2)<br/>     lblstatus.Caption = ""<br/>     <br/>     <br/>     '获取选择集对象<br/>     Set sset = objacad.ActiveDocument.SelectionSets.add("ss1")<br/>     Call sset.SelectAtPoint(point)<br/>     If sset.Count = 1 Then<br/>            If StrComp(sset(0).EntityName, "acdbblockreference", 1) = 0 Then<br/>              gethandle = sset(0).Handle<br/>              Else<br/>                MsgBox "没有图块被选中"<br/>                gethandle = ""<br/>                End If<br/>     Else<br/>           If sset.Count = 0 Then<br/>           Form1.Hide<br/>           MsgBox "没有图块被选中"<br/>           Form1.Show<br/>           End If<br/>           If sset.Count &gt; 1 Then<br/>           MsgBox "选中图块超过一个"<br/>           End If<br/>           gethandle = ""<br/>    End If<br/>    Exit Function<br/>    <br/>

mccad 发表于 2007-5-2 07:32:00

<p>选择单个对象要以使用GetEntity方法，而判断选中对象是否为文本可以使用ObjectName属性来判断是否为“AcDbText”，获取文本的内容可以使用TextString属性。</p>

Lostvivi 发表于 2007-5-2 11:04:00

谢谢您的提示，我用您的方法试试看<br/><br/>
页: [1]
查看完整版本: [求助]如何在VB环境下获取AutoCAD的Text（文本对象），请教各位啦