请教高手，想要通过VB实现多行文本的某些内容修改该怎么办？

irisamazon

下面是我对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

leeyeafu

多行文本内的回车用控制字符 \P 表示。也就是说，含回车的多行文字其TextString属性实际上是一个包含 \P 控制字符的字串。这样你应该可以用你的方法去控制和编辑它了。
当然，多行文本的VB类型名为AcadMText，其ObjectName属性为AcDbMText。
最后，On Error Resume Next不需要多次声明。

irisamazon

非常感谢leeyeafu,我把程序按照你的建议重新调试一遍,真的可以了耶.
还有一个请求,不知道你能建议一下,在那里可以找到CAD属性的VB后缀的解释吗??不好意思,我对VB操作CAD中应用的属性的集合知道的不多.

leeyeafu

irisamazon

如何对已存在的MTEXT文本画出边框线呢(line),文本可能是多行的.

leeyeafu

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

irisamazon

版主,按照你的办法已经试过了,很成功!

Thank u very much!

__________________________________
学海无涯!我要好好学习!天天向上!向版主学习!

mccad

你可以参考实用函数中的两个函数来绘制这个边框：
DrawBoundingBox  绘制对象的外方框
http://www.mjtd.com/function/list.asp?id=299&ordertype=byletter
AddRectangle  通过对角两点绘制矩形的函数  
http://www.mjtd.com/function/list.asp?id=189&ordertype=byletter

myfreemind