本帖最后由 Flyingdancing 于 2012-8-15 19:49 编辑
- Sub dd()
- Dim sel As AcadSelectionSet
- Dim t As AcadText '这里假定只是单行文字,不包括多行文字
- Dim 相对点 As Variant
- Dim 文字点 As Variant
- '根据一点获取文字内容,
- '此点必须为文字的线条所在的位置,文字空白处无效,并且必须保证此点只有一个文字
- '这条对于文字没有实用意义,但是对于某些情况,选直线特别有用
- 文字点 = ThisDrawing.Utility.GetPoint(, "请指定文字位置")
- '或者可以根据某个向量确定文字点
- '相对点 = ThisDrawing.Utility.GetPoint(, "请指定文字的相对点")
- '向量如下(可以直接设定,也可选两点进行计算确定)
- 'Dim 向量(2) As Variant
- '向量(0) = 3: 向量(1) = 3: 向量(2) = 3
- 'Dim 文字点(2) As Variant
- 'For i = 0 To 2
- '文字点(i) = 相对点(i) + 向量(i)
- 'Next
- On Error Resume Next
- ThisDrawing.SelectionSets("文字").Delete
- Set sel = ThisDrawing.SelectionSets.Add("文字")
- sel.Select acSelectionSetCrossing, 文字点, 文字点
- If sel.Count <> 1 Then Exit Sub '可以设定其他操作,包括提示等
- For Each t In sel
- Stri = t.TextString
- MsgBox "所选位置处文字内容为" & Stri
- Next
- '根据两点(此两点属于文字外形框的外部点,并且不在同一水平或垂直线上)获取文字内容,
- '并且必须保证此两点所成矩形内只有一个文字
- '可用于表格文字的定位、输入和修改
- Dim 文字点1 As Variant
- Dim 文字点2 As Variant
- 文字点1 = ThisDrawing.Utility.GetPoint(, "请指定文字角点")
- 文字点2 = ThisDrawing.Utility.GetPoint(文字点1, "请指定文字另一角点")
- sel.Select acSelectionSetWindow, 文字点1, 文字点2 '用于表格内容不超过两点范围
- If sel.Count <> 1 Then Exit Sub
- For Each t In sel
- Stri = t.TextString
- MsgBox "所选位置处文字内容为" & Stri
- Next
|