dhxf 发表于 2004-4-17 23:29:00

怎么说呢：5行变单行是文休里面的命令，变的时候不加空格；

mccad 发表于 2004-4-18 07:51:00

用这个程序处理怎样(还没加详细处理，只完成功能性)：
注意直接处理多行文字。Sub MtextToText()
       Dim ent As AcadEntity
       Dim pnt As Variant
       Dim cnt As Long
       ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
       ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
                                                       & ent.Handle & Chr(34) & ")" & vbCr & vbCr
       Dim ss As AcadSelectionSet
       On Error Resume Next
       ThisDrawing.SelectionSets("CURRENT").Delete
       Set ss = ThisDrawing.ActiveSelectionSet
       Debug.Print ss.Name
       Dim i As Long
       Dim Ents(0) As AcadEntity
       For i = 0 To ss.Count - 1
               If i <> 0 Then ss(0).TextString = ss(0).TextString & " " & ss(i).TextString
       Next
       Set Ents(0) = ss(0)
       ss.RemoveItems Ents
       ss.Erase
End Sub

雪山飞狐_lzh 发表于 2004-4-18 09:54:00

本帖最后由 作者 于 2004-4-18 19:52:19 编辑

多行变单行将字符串中"\P"替换为空格，多行文本宽度设为0就可以了多行炸开有点问题：如果一行上有几种字体，会分隔成几部分Sub MToS()
       Dim ent As AcadEntity
       Dim pnt As Variant, a As Variant
       Dim cnt As Long
       Dim b As String
       ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
       a = Split(ent.TextString, "\P")
       For i = 0 To UBound(a) - 1
               b = b & a(i) & " "
       Next i
       b = b & a(i)
       ent.Width = 0
       ent.TextString = b
End Sub

mccad 发表于 2004-4-18 20:11:00

来更简单的：Sub MtextToText2()
       Dim pnt, ent As AcadEntity
      ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
       ent.TextString = Replace(ent.TextString, "\P", " ")
       ent.Width = 0
End Sub
正在考虑怎样用程序来取消多行文字的中格式设置。

mccad 发表于 2004-4-18 20:36:00

把我的两个程序结合起来，就可以很多的解决多行文字中的格式设置问题：
Sub MtextToText2()
       Dim ent As AcadEntity
       Dim pnt As Variant
       Dim cnt As Long
       ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
       ent.TextString = Replace(ent.TextString, "\P", " ")
       ent.Width = 0
       ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
                                                       & ent.Handle & Chr(34) & ")" & vbCr & vbCr
       Dim ss As AcadSelectionSet
       On Error Resume Next
       ThisDrawing.SelectionSets("CURRENT").Delete
       Set ss = ThisDrawing.ActiveSelectionSet
       Dim i As Long
       Dim Ents(0) As AcadEntity
       For i = 0 To ss.Count - 1
               If i <> 0 Then ss(0).TextString = ss(0).TextString & ss(i).TextString
       Next
       Set Ents(0) = ss(0)
       ss.RemoveItems Ents
       ss.Erase
End Sub

雪山飞狐_lzh 发表于 2004-4-18 20:40:00

本帖最后由 作者 于 2004-4-20 11:45:07 编辑

取消多行文字的中格式设置，只有再把它炸开再合并Sub MToS()
       Dim pnt, ent As AcadMText
       Dim m As Integer, n As Integer
       ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
       ent.TextString = Replace(ent.TextString, "\P", " ")
       ent.Width = 0
       m = ThisDrawing.ModelSpace.Count
       ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
                                                       & ent.Handle & Chr(34) & ")" & vbCr & vbCr
       n = ThisDrawing.ModelSpace.Count
       If m = n Then Exit Sub
       For i = m + 1 To n
               ThisDrawing.ModelSpace(m - 1).TextString = _
                                                       ThisDrawing.ModelSpace(m - 1).TextString + _
                                                       ThisDrawing.ModelSpace(m).TextString
               ThisDrawing.ModelSpace(m).Delete
       Next i
End Sub

雪山飞狐_lzh 发表于 2004-4-18 20:45:00

^_^


居然跟明总抢进度起来了，该死，该死

dhxf 发表于 2004-4-22 22:01:00

进来才看到---抱歉


看了几段程序,怎么用呢?汗,还得请教各位老大;


马后炮说一句,我只是做[单行文字]点选位置增加空格,看各位老大都进步做到[多行文字],谢谢谢谢;
页: 1 [2]
查看完整版本: [编程申请］字符串中间点选增加空格