[求助]再次提问，关于VB中获取CAD文本
这是我发的原贴http://bbs.mjtd.com/forum.php?mod=viewthread&tid=59890，感谢明总！！（看论坛大家都这样叫）<br/>原贴里面是我在一本书上抄的一段代码（实际上我也没全看明白，接触CAD的VB开发才几天，很多东西都不是很明白）<br/>明总提示后我参照CAD开发帮助文档自己写了一段代码，还是有错，再次拜托高手帮忙修改或者提示下啦，真的很急用。<br/>（我要实现的功能，点击command后切换到CAD窗口，提示点选一个单行文本，然后获取该文本的textstring赋给一个VB的文本框）<br/><br/><br/>Dim acadApp As autocad.AcadApplication<br/>Dim AcadDoc As AcadDocument<br/><br/><br/>Private Sub Command1_Click()<br/>StartAcad<br/>Dim OBJdoc As AcadText<br/>Dim ptPick As Variant<br/><br/>Set acadApp = New autocad.AcadApplication<br/><br/>Set AcadDoc = acadApp.ActiveDocument<br/><br/>AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"<br/><br/>Text1.Text = OBJdoc.TextString<br/>End Sub<br/><br/>Sub StartAcad()<br/> Dim acadApp As AcadApplication<br/> On Error Resume Next<br/><br/> Set acadApp = GetObject(, "AutoCAD.Application.16")<br/> If Err Then<br/> Err.Clear<br/> Set acadApp = CreateObject("AutoCAD.Application.16")<br/> If Err Then<br/> MsgBox Err.Description<br/> Exit Sub<br/> End If<br/> End If<br/> MsgBox "Now running " + acadApp.Name + " version " + acadApp.Version<br/>End Sub<br/><br/><br/><br/> 同一个问题发两个帖子不知道是否违规？<br/>真的是急用这段代码，而且我想这是一个很简单的任务吧（对于已经入门的人来说）。希望有能力帮忙的不吝赐教。<br/> <p>刚刚看到，这样试试：</p><p>Dim acadApp As AutoCAD.AcadApplication<br/>Dim AcadDoc As AcadDocument</p><p>Private Sub Command1_Click()</p><p>'隐藏自身窗体，以把控制权交给CAD<br/><font color="#ff0000">Me.Hide</font><br/>StartAcad</p><p>‘激活CAD窗体进行操作<br/><font color="#ff0000">AppActivate (acadApp.Caption)</font></p><p>Dim OBJdoc As AcadText<br/>Dim ptPick As Variant</p><p>Set AcadDoc = acadApp.ActiveDocument</p><p>AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"</p><p>Text1.Text = OBJdoc.TextString</p><p>'重新显示自身<br/><font color="#f70909">Me.Show</font><br/>End Sub</p><p>Sub StartAcad()<br/><font color="#ff0000"> <strong>Dim acadApp As AcadApplication’</strong>已经定义为模块级变量了，这句必须去掉！<br/></font> On Error Resume Next</p><p> Set acadApp = GetObject(, "AutoCAD.Application.16")<br/> If Err Then<br/> Err.Clear<br/> Set acadApp = CreateObject("AutoCAD.Application.16")<br/> If Err Then<br/> MsgBox Err.Description<br/> Exit Sub<br/> End If<br/> End If<br/> MsgBox "Now running " + acadApp.Name + " version " + acadApp.Version<br/>End Sub<br/></p> <p>再优化一下,声明API，使自身窗体置前:</p><p>Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _<br/> As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long<br/></p><p>在Me.show后面加上一句：</p><p>SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3</p><p>这样的易用性更好些。</p> 谢谢StartMe，我用你的提示再做做。 能够切换到CAD窗口，但是还有和我先前一样的错误出现。<br/>错误锁定在这句“AcadDoc.Utility.GetEntity OBJdoc, ptPick, "请点选文本"”。<br/>这句是否是书写格式的错误？<br/> 提示为“AutoCAD主窗口不可见” 调试发现程序并没有通过点选获得OBJdoc，因为objdoc.textstring仍然为空 <p>运行正常啊，没有错误。</p> <p></p><p> </p><p></p><p></p><p>你再仔细检查一下是否程序中其它语句的影响，单就这几句是没错误的。</p><p>你单独运行这几句试试看。</p>
页:
[1]
2