meritw 发表于 2010-7-9 09:48:00

[讨论][求助]vba利用鼠标获取text里面的数值。

<font face="Verdana"><font face="Verdana">各位达人，在VBA中如何利用鼠标获取text里面的数值？</font></font>

zuehuo 发表于 2010-7-9 19:31:00

<p>没人 回答 呀 </p>
<p>&nbsp;</p>

雪山飞狐_lzh 发表于 2010-7-9 21:27:00

<p>问题描述的太简单，没看懂</p>

meritw 发表于 2010-7-12 10:24:00

<p><font face="Verdana">终于搞出来了</font></p>
<p><font face="Verdana">贡献一下：</font></p>
<p><font face="Verdana"></font>&nbsp;</p>
<p><font face="Verdana">Public Function selectTextNum() As Double<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; Dim ssetobj As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim strText As String, dblText As Double<br/>&nbsp;&nbsp;&nbsp; Dim blnHaveFoundText As Boolean, intCount As Integer<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets("getTextNum").Delete<br/>&nbsp;&nbsp;&nbsp; Set ssetobj = ThisDrawing.SelectionSets.Add("getTextNum")<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Utility.Prompt "请选择&lt;Text&gt;格式的实体！"<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim pickedObjs As AcadEntity<br/>&nbsp;&nbsp;&nbsp; '循环每个被选择的实体<br/>&nbsp;&nbsp;&nbsp; blnHaveFoundText = False: intCount = 0<br/>&nbsp;&nbsp;&nbsp; Do<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ssetobj.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If checkkey(escape) = True Then GoTo Finish:<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then Err.Clear<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ssetobj.count = 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If vbNo = MsgBox("没有选择实体，是否重新点选？", vbYesNo) Then selectTextNum = -1: Exit Function 'GoTo Finish '如果没有选择物体，结束程序<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each pickedObjs In ssetobj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If TypeOf pickedObjs Is AcadPolyline Or TypeOf pickedObjs Is Acad3DPolyline Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Debug.Print pickedObjs.ObjectName<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If pickedObjs.ObjectName = "AcDbMText" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pickedObjs.Highlight (True) ' = acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '可将所有被选择实体将变为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strText = pickedObjs.textString<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dblText = pickedObjs.Text<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; selectTextNum = CDbl(strText)&nbsp;&nbsp;&nbsp; '得到每个实体对象的文本内容<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pickedObjs.Highlight (False) ' = acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '可将所有被选择实体将变为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If pickedObjs.ObjectName = "AcDbText" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pickedObjs.Highlight (True) ' = acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '可将所有被选择实体将变为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strText = pickedObjs.textString<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; selectTextNum = CDbl(strText)&nbsp;&nbsp;&nbsp; '得到每个实体对象的文本内容<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pickedObjs.Highlight (False) ' = acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '可将所有被选择实体将变为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.Utility.Prompt "成功选取数值" &amp; selectTextNum &amp; ";" &amp; vbCrLf<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blnHaveFoundText = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; intCount = intCount + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If False = blnHaveFoundText Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If intCount &lt; 3 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If vbNo = MsgBox("没有找到&lt;Text&gt;格式的实体，是否重新点选？", vbYesNo + vbQuestion) Then selectTextNum = -1: Exit Function<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "没有找到&lt;Text&gt;格式的实体，尝试超过3次，请手动输入！", vbInformation + vbCritical<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; selectTextNum = -1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Function<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Loop While (False = blnHaveFoundText And intCount &lt; 3)<br/>&nbsp;&nbsp;&nbsp; ssetobj.Clear:&nbsp; ssetobj.Delete<br/>&nbsp;&nbsp;&nbsp; Exit Function<br/>Finish:<br/>&nbsp; ssetobj.Delete<br/>&nbsp; selectTextNum = -1<br/>End Function<br/></p></font>

guanxiancad2006 发表于 2010-7-29 10:34:00

checkkey(escape)？
页: [1]
查看完整版本: [讨论][求助]vba利用鼠标获取text里面的数值。