[编程申请］字符串中间点选增加空格

dhxf

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

mccad

用这个程序处理怎样(还没加详细处理，只完成功能性)：
注意直接处理多行文字。

2. Sub MtextToText()
3.        Dim ent As AcadEntity
4.        Dim pnt As Variant
5.        Dim cnt As Long
6.        ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
7.        ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
8.                                                        & ent.Handle & Chr(34) & ")" & vbCr & vbCr
9.        Dim ss As AcadSelectionSet
10.        On Error Resume Next
11.        ThisDrawing.SelectionSets("CURRENT").Delete
12.        Set ss = ThisDrawing.ActiveSelectionSet
13.        Debug.Print ss.Name
14.        Dim i As Long
15.        Dim Ents(0) As AcadEntity
16.        For i = 0 To ss.Count - 1
17.                If i <> 0 Then ss(0).TextString = ss(0).TextString & " " & ss(i).TextString
18.        Next
19.        Set Ents(0) = ss(0)
20.        ss.RemoveItems Ents
21.        ss.Erase
22. End Sub

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

多行变单行将字符串中"\P"替换为空格，多行文本宽度设为0就可以了多行炸开有点问题：如果一行上有几种字体，会分隔成几部分

2. Sub MToS()
3.        Dim ent As AcadEntity
4.        Dim pnt As Variant, a As Variant
5.        Dim cnt As Long
6.        Dim b As String
7.        ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
8.        a = Split(ent.TextString, "\P")
9.        For i = 0 To UBound(a) - 1
10.                b = b & a(i) & " "
11.        Next i
12.        b = b & a(i)
13.        ent.Width = 0
14.        ent.TextString = b
15. End Sub

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

来更简单的：

2. Sub MtextToText2()
3.        Dim pnt, ent As AcadEntity
4.         ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
5.        ent.TextString = Replace(ent.TextString, "\P", " ")
6.        ent.Width = 0
7. End Sub

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

把我的两个程序结合起来，就可以很多的解决多行文字中的格式设置问题：

3. Sub MtextToText2()
4.        Dim ent As AcadEntity
5.        Dim pnt As Variant
6.        Dim cnt As Long
7.        ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
8.        ent.TextString = Replace(ent.TextString, "\P", " ")
9.        ent.Width = 0
10.        ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
11.                                                        & ent.Handle & Chr(34) & ")" & vbCr & vbCr
12.        Dim ss As AcadSelectionSet
13.        On Error Resume Next
14.        ThisDrawing.SelectionSets("CURRENT").Delete
15.        Set ss = ThisDrawing.ActiveSelectionSet
16.        Dim i As Long
17.        Dim Ents(0) As AcadEntity
18.        For i = 0 To ss.Count - 1
19.                If i <> 0 Then ss(0).TextString = ss(0).TextString & ss(i).TextString
20.        Next
21.        Set Ents(0) = ss(0)
22.        ss.RemoveItems Ents
23.        ss.Erase
24. End Sub

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

取消多行文字的中格式设置，只有再把它炸开再合并

2. Sub MToS()
3.        Dim pnt, ent As AcadMText
4.        Dim m As Integer, n As Integer
5.        ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "请选择多行文字："
6.        ent.TextString = Replace(ent.TextString, "\P", " ")
7.        ent.Width = 0
8.        m = ThisDrawing.ModelSpace.Count
9.        ThisDrawing.SendCommand "Explode" & vbCr & "(handent " & Chr(34) _
10.                                                        & ent.Handle & Chr(34) & ")" & vbCr & vbCr
11.        n = ThisDrawing.ModelSpace.Count
12.        If m = n Then Exit Sub
13.        For i = m + 1 To n
14.                ThisDrawing.ModelSpace(m - 1).TextString = _
15.                                                        ThisDrawing.ModelSpace(m - 1).TextString + _
16.                                                        ThisDrawing.ModelSpace(m).TextString
17.                ThisDrawing.ModelSpace(m).Delete
18.        Next i
19. End Sub

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

^_^


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

dhxf

进来才看到---抱歉


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


马后炮说一句,我只是做[单行文字]点选位置增加空格,看各位老大都进步做到[多行文字],谢谢谢谢;