请教高手，想要通过VB实现多行文本的某些内容修改该怎么办？
下面是我对text文本编辑用的源程序，但是如果简单的该成对多行文本进行操作的话，程序不能起作用，我要修改编号的多行文本是包括两行文字的，不知道多行文本中有回车的话该如果操作？:'(Dim textObj As AcadText
Dim aaa As String
Dim bbb As Double
Dim ss As AcadSelectionSet
Dim Enf As AcadEntity
Dim Ent As AcadText
Dim qq As String
Dim cd As Double
Dim xhcd As Double
Dim zj As Double
Dim changdu As Double
Dim zero As String
Dim errornumber
Sub 改编号程序()
MsgBox "该程序用于编号+1"
On Error Resume Next
qq = ThisDrawing.Utility.GetString(20, vbCrLf & "请输入要更改的ISO代号:" & vbCrLf)
On Error Resume Next
cd = ThisDrawing.Utility.GetString(1, vbCrLf & "请输入刚才输入ISO代号的长度:" & vbCrLf)
On Error Resume Next
xhcd = ThisDrawing.Utility.GetString(1, vbCrLf & "请输入识别用后面的编号长度:(1～4)" & vbCrLf)
On Error Resume Next
zj = CDbl(ThisDrawing.Utility.GetString(4, vbCrLf & "请输入条件Number(编号>Number)" & vbCrLf))
Set ss = GetSelSet
For Each Enf In ss
If Enf.ObjectName = "AcDbText" Then
changdu = Len(CStr(Enf.textString))
changdu = changdu - CDbl(xhcd)
aaa = Right(CStr(Enf.textString), CDbl(xhcd))
bbb = CDbl(aaa)
If bbb > CDbl(zj) And Left(CStr(Enf.textString), CDbl(cd)) = CStr(qq) Then
bbb = CDbl(aaa) + 1
aaa = CDbl(bbb)
Select Case xhcd
Case Is = 1
zero = ""
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(aaa)
Case Is = 2
zero = "0"
Select Case bbb
Case Is < 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & "0" & CStr(aaa)
Case Is >= 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(aaa)
End Select
Case Is = 3
zero = "00"
Select Case bbb
Case Is < 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(zero) & CStr(aaa)
Case Is >= 100
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(aaa)
Case Is >= 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & Left(CStr(zero), 1) & CStr(aaa)
End Select
Case Is = 4
zero = "000"
Select Case bbb
Case Is < 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(zero) & CStr(aaa)
Case Is >= 1000
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & CStr(aaa)
Case Is >= 100
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & Left(CStr(zero), 1) & CStr(aaa)
Case Is >= 10
Enf.textString = Left(CStr(Enf.textString), CDbl(changdu)) & Left(CStr(zero), 2) & CStr(aaa)
End Select
End Select
End If
End If
Next
line1:
End Sub
Function GetSelSet() As AcadSelectionSet
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.PickfirstSelectionSet
If ss.Count = 0 Then
Dim ssName As String
ssName = "strSSet"
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
ss.SelectOnScreen
End If
Set GetSelSet = ss
End Function
大致看了你的程序,给一点点建议
多行文本内的回车用控制字符 \P 表示。也就是说，含回车的多行文字其TextString属性实际上是一个包含 \P 控制字符的字串。这样你应该可以用你的方法去控制和编辑它了。当然，多行文本的VB类型名为AcadMText，其ObjectName属性为AcDbMText。
最后，On Error Resume Next不需要多次声明。
成功了 口耶!
非常感谢leeyeafu,我把程序按照你的建议重新调试一遍,真的可以了耶.还有一个请求,不知道你能建议一下,在那里可以找到CAD属性的VB后缀的解释吗??不好意思,我对VB操作CAD中应用的属性的集合知道的不多.
可以参考ACAD的VBA帮助，mccad总版主在本站作了部分汉化
请问版主
如何对已存在的MTEXT文本画出边框线呢(line),文本可能是多行的.Re:
AcadMText对象的Height属性返回多行文本的高度， Width属性返回其宽度。InsertPoint属性返回插入点位置。根据这三个属性，你可以画出其边框线。不过使用InsertPoint属性时要注意：根据MText对象的AttachmentPoint属性的不同值，InsertPoint指示的是文本的不同位置。
例如：若ObjMText.AttachmentPoint=1，InsertPoint指文本的左上角。
ObjMText.AttachmentPoint=2，InsertPoint指文本的中上部。
......
见下表：数字表示AttachmentPoint值，位置相当于InsertPoint指示文本的不同位置点。
1 2 3
4 5 6
7 8 9
祝源码分析越办越好!!
版主,按照你的办法已经试过了,很成功!Thank u very much!
__________________________________
学海无涯!我要好好学习!天天向上!向版主学习!
对于画外边框，可以使用GetBoundingBox方法来获取对象的外框坐标
你可以参考实用函数中的两个函数来绘制这个边框：DrawBoundingBox绘制对象的外方框
http://www.mjtd.com/function/list.asp?id=299&ordertype=byletter
AddRectangle通过对角两点绘制矩形的函数
http://www.mjtd.com/function/list.asp?id=189&ordertype=byletter
解决了我的大难题！感谢~~~
页:
[1]