求助 VBA中如何求得多行字的实际内容

cjb2187 · 发表于 2009-9-30 13:13:00

在的使用中,不免要使用多行文字,但多行文字在VBA编程时有些问题却令我头昏脑胀,如下图

nlmmrkfulax.jpg

图中所示为一个多行文字,选中它然后使用TEXTSTRING属性,返回一组字符串如下:
\A1;{\H1.6x;\{A}\P{\LB}\P{\H1.6x;C;}\P{\fCorbel|b0|i0|c0|p34;D}\P{\C1;E}\PF\PG
其实这串字符串并不是给我们看的,而是针对CAD文字编辑器的,其中"\"是转义符,以标明多行字所使用的格式
例如:\P表示转行
\A1;表示文字对齐的样式
。。。。。这里就不一一详述了，有兴趣的朋友可以在网上搜搜看，问题是否串字符串并不是我所需要的，我想要的是
{ABC;DEFG
差距比较遥远，大家有什么好办法呢？
求助 VBA中如何求得多行字的实际内容

dtrpdbxysqm.jpg

cjb2187 · 发表于 2009-10-3 12:03:00

转过去的链接中大家讨论得已经比较详细了,我比较喜欢mccad大虾的思路,但是我觉得他所提供的函数中有一点点瑕疵,最起码我用
"\A1;\{{\H1.6x;A}\P{\LB}\P{\H1.6x;C;}\P\pi0.999306,l2.99792,t7;{\fCorbel|b0|i0|c0|p34;D}\P\pi0,l0,tz;{\C1;E}\PF?\PG\\\Ph{\H0.7x;\S1/2;}\PJ{\H0.7x;\S2^;}\PK{\H0.7x;\S^2;}|\PL"
这个字符串作核试验的时候就不完全正确,而且稍显繁复,所以我重新总结了一下,得出下面的两个函数,请众位同好不吝指正
第一个是用RegExp来替换的自定义函数

copy


Public Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)
     Dim RE As Object
     Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")
     
     RE.IgnoreCase = False
     RE.Global = True
     
     RE.Pattern = TxtFind
     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)
     Set RE = Nothing
     
End Function

第二个是用来清除多行字格式的函数

copy


Public Function MtextStringClearFormat(ByVal MyString As String) As String
    MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))
    MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))
    MyString = ReplaceByRegExp(MyString, "\\", Chr(3))
    MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")
    MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")
    MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")
    MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")
    MyString = ReplaceByRegExp(MyString, "\x01", "{")
    MyString = ReplaceByRegExp(MyString, "\x02", "}")
    MyString = ReplaceByRegExp(MyString, "\x03", "")
    MtextStringClearFormat = Trim(MyString)
End Function

最后写一个测试过程

copy


Sub TEST()
    Dim TxtOld As String
    Dim TxtNew As String
    TxtOld = "\A1;\{{\H1.6x;A}\P{\LB}\P{\H1.6x;C;}\P\pi0.999306,l2.99792,t7;{\fCorbel|b0|i0|c0|p34;D}\P\pi0,l0,tz;{\C1;E}\PF?\PG\\\Ph{\H0.7x;\S1/2;}\PJ{\H0.7x;\S2^;}\PK{\H0.7x;\S^2;}|\PL"
    TxtNew = MtextStringClearFormat(TxtOld)
    
End Sub

大家再帮我用其它的字符串测试一下,看看是不是有所遗漏或是BUG,谢谢了

烟雨.江南 · 发表于 2009-10-5 21:34:00

编了一些自己常用到的CAD相关的函数，刚好有这个从MText提取文本的。我是在WinXPSP2+VB6SP4+CAD2006下调试的，可能有BUG也说不定。如果觉得能用上就下载吧。使用方法如下面这个函数：
Sub test()
Dim a As Object, strTmp$
Set a = CreateObject("ZWCADComm.ZWCADPublic")
strTmp = a.GetTextFromMText("\A1;{\H1.6x;\{A}\P{\LB}\P{\H1.6x;C;}\P{\fCorbel|b0|i0|c0|p34;D}\P{\C1;E}\PF\PG")
End Sub
也可以在工程中引用，然后用
dim a as new ZWCADComm.ZWCADPublic
这样的语句来引用。

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载