如何统一MTEXT的文字格式
<p>在CAD中,有很多MTEXT的shx不一样,有txt.shx,有HZTXT.SHX,KHZTEX.SHX</p><p>如何将他们统一为hztx.shx</p> 本帖最后由 作者 于 2009-3-26 2:23:19 编辑 <br /><br /> <p>先建立字体为hztx.shx的文字样式，并应用到所有多行文字。</p><p>特性栏-文字-内容，如果多行文字带有复杂格式，可应用以下vba程序，基本可以解决问题：</p><p>Option Explicit</p><p>' 拾取多行文字，获得其文字内容,并进行替换<br/>Public Sub GetAndReplaceMTextString()<br/> Dim SSet As AcadSelectionSet<br/> Set SSet = ThisDrawing.PickfirstSelectionSet<br/> If SSet.Count = 0 Then<br/> MsgBox "未选择对象"<br/> Exit Sub<br/> End If<br/> Dim objMText As AcadEntity<br/> Dim ptMin As Variant, ptMax As Variant<br/> Dim ptCenter(0 To 2) As Double<br/> Dim radius As Double<br/> For Each objMText In SSet<br/> If TypeOf objMText Is AcadMText Then<br/> objMText.TextString = GetMTextUnformatString(objMText.TextString)<br/> End If<br/> Next<br/> ThisDrawing.Regen True<br/>End Sub</p><p>Public Function GetMTextUnformatString(MTextString As String) As String<br/> Dim s As String<br/> Dim RE As Object<br/> ' 获取Regular Expressions组件<br/> Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")<br/> ' 忽略大小写<br/> RE.IgnoreCase = True<br/> ' 搜索整个字符串<br/> RE.Global = True<br/> s = MTextString<br/> <br/> '替换\\字符<br/> RE.Pattern = "<a>\\\\</a>"<br/> s = RE.Replace(s, Chr(1))<br/> '替换\{字符<br/> RE.Pattern = "\\{"<br/> s = RE.Replace(s, Chr(2))<br/> '替换\}字符<br/> RE.Pattern = "\\}"<br/> s = RE.Replace(s, Chr(3))<br/> <br/> '删除段落缩进格式<br/> RE.Pattern = "<a href="file://pi/">\\pi</a>(.[^;]*);"<br/> s = RE.Replace(s, "")<br/> '删除制表符格式<br/> RE.Pattern = "<a href="file://pt/">\\pt</a>(.[^;]*);"<br/> s = RE.Replace(s, "")<br/>' '删除堆迭格式<br/>' RE.Pattern = "<a href="file://S(.[^;]*)(/^|#|//">\\S(.[^;]*)(\^|#|\\</a>)(.[^;]*);"<br/>' s = RE.Replace(s, "$1$3")<br/> '删除字体、颜色、字高、字距、倾斜、字宽、对齐格式<br/> RE.Pattern = "(<a href="file:///F|//C|//H|//T|//Q|//W|//A">\\F|\\C|\\H|\\T|\\Q|\\W|\\A</a>)(.[^;]*);"<br/> s = RE.Replace(s, "")<br/> '删除下划线、删除线格式<br/> RE.Pattern = "(<a href="file:///L|//O|//l|//o">\\L|\\O|\\l|\\o</a>)"<br/> s = RE.Replace(s, "")<br/> '删除不间断空格格式<br/> RE.Pattern = "\\~"<br/> s = RE.Replace(s, " ")<br/> '删除换行符格式<br/> RE.Pattern = "<a href="file://P/">\\P</a>"<br/> s = RE.Replace(s, "")<br/> '删除换行符格式(针对Shift+Enter格式)<br/> RE.Pattern = vbLf<br/> s = RE.Replace(s, "")<br/> '删除{}<br/> RE.Pattern = "({|})"<br/> s = RE.Replace(s, "")<br/> <br/> '替换回<a href="file://,/{,/">\\,\{,\</a>}字符<br/> RE.Pattern = "\x01"<br/> s = RE.Replace(s, "\")<br/> RE.Pattern = "\x02"<br/> s = RE.Replace(s, "{")<br/> RE.Pattern = "\x03"<br/> s = RE.Replace(s, "}")<br/> <br/> Set RE = Nothing<br/> <br/> GetMTextUnformatString = s<br/>End Function</p><p></p>
页:
[1]