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

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

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

各位达人，在VBA中如何利用鼠标获取text里面的数值？

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

没人 回答 呀

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

问题描述的太简单，没看懂

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

终于搞出来了
贡献一下：

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

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

checkkey(escape)？

查看完整版本: [讨论][求助]vba利用鼠标获取text里面的数值。