arman88 发表于 2022-7-6 09:49:54

亲爱的刺猬谢谢。我得到了它。它工作得很好眨眼:
我的源路径有点远:
C: \文档和设置\管理员\应用程序数据\ Autodesk\AutoCAD 2007\R17.0\chs\支持
 
我也找到了用于剥离多行文字的VBA代码,很快就会放到这里。
 
顺便说一句,在你的签名中找到了很棒的照片库!

arman88 发表于 2022-7-6 09:53:24


Option Explicit
' written by Bryco

Function UnformatMtext(S As String) As String

Dim P1 As Integer
Dim P2 As Integer, P3 As Integer
Dim intStart As Integer
Dim strCom As String
Dim strReplace As String

Debug.Print S

Select Case Left(S, 4)
Case "\A0;", "\A1;", "\A2;"
S = Mid(S, P1 + 5)
End Select
intStart = 1
Do
P1 = InStr(S, "%%")
If P1 = 0 Then
Exit Do
Else
Select Case Mid(S, P1 + 2, 1)
Case "P"
S = Replace(S, "%%P", "+or-")
Case "D"
S = Replace(S, "%%D", " deg")
End Select
End If
Loop

Do
P1 = InStr(intStart, S, "\", vbTextCompare)
If P1 = 0 Then Exit Do
strCom = Mid(S, P1, 2)
Select Case strCom
Case "\p"
P2 = InStr(1, S, ";")
S = Mid(S, P2 + 1)
Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, strCom, vbTextCompare)
If P3 = 0 Then
S = Left(S, P1 - 1) & Mid(S, P2 + 1)
End If
Do While P3 > 0
P2 = InStr(P3, S, ";", vbTextCompare)
S = Left(S, P3 - 1) & Mid(S, P2 + 1)
'Debug.Print s, strCom
P3 = InStr(1, S, strCom, vbTextCompare)
Loop
's = Left(s, P3 - 1) & mid(s, P3 + 1)
'Case "\L", "\O"
'Dim strLittle As String
'strLittle = LCase(strCom)
'P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
'S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
'//============== fixed by fla_2
'// example {\fArial|b1|i0|c0|p34;\LGENERAL NOTES :}
Case "\L", "\O"
Dim strLittle As String
strLittle = LCase(strCom)
P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
If P2 = 0 Then
S = Left(S, P1 - 1) & Mid(S, P1 + 2)
Else
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
End If
'//==============
Case "\S"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, "/", vbTextCompare)
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "#", vbTextCompare)
End If
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "^", vbTextCompare)
End If
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P3 - (P1 + 2)) _
& "/" & Mid(S, P3 + 1, (P2) - (P3 + 1)) & Mid(S, P2 + 1)

Case "\U"
strLittle = Mid(S, P1 + 3, 4)
Debug.Print strLittle
Select Case strLittle
Case "2248"
strReplace = "ALMOST EQUAL"
Case "2220"
strReplace = "ANGLE"
Case "2104"
strReplace = "CENTER LINE"
Case "0394"
strReplace = "DELTA"
Case "0278"
strReplace = "ELECTRIC PHASE"
Case "E101"
strReplace = "FLOW LINE"
Case "2261"
strReplace = "IDENTITY"
Case "E200"
strReplace = "INITIAL LENGTH"
Case "E102"
strReplace = "MONUMENT LINE"
Case "2260"
strReplace = "NOT EQUAL"
Case "2126"
strReplace = "OHM"
Case "03A9"
strReplace = "OMEGA"
Case "214A"
strReplace = "PROPERTY LINE"
Case "2082"
strReplace = "SUBSCRIPT2"
Case "00B2"
strReplace = "SQUARED"
Case "00B3"
strReplace = "CUBED"

End Select
S = Replace(S, "\U+" & strLittle, strReplace)

Case "\~"
S = Replace(S, "\~", " ")

Case "\\"
intStart = P1 + 2
S = Replace(S, "\\", "\")
GoTo Selectagain

Case "\P"
intStart = P1 + 1
GoTo Selectagain
Case Else
Exit Do
End Select
Selectagain:
Loop

Do
P1 = InStr(1, S, "\P", vbTextCompare)
If P1 = 0 Then
Exit Do
Else
S = Left(S, P1 - 1) & vbCrLf & Mid(S, P1 + 2)
End If
Loop
For intStart = 0 To 1
If intStart = 0 Then
strCom = "}"
Else
strCom = "{"
End If
P2 = InStr(1, S, strCom)

Do While P2 > 0
S = Left(S, P2 - 1) & Mid(S, P2 + 1)
P2 = InStr(1, S, strCom)
Loop
Next intStart


UnformatMtext = S

End Function

Sub Testmt()
Dim Mt As AcadMText, V As Variant
ThisDrawing.Utility.GetEntity Mt, V, "Pick an Mtext:"
MsgBox Mt.TextString
Debug.Print Mt.TextString
MsgBox Mt.TextString
Mt.TextString = UnformatMtext(Mt.TextString)
MsgBox Mt.TextString
End Sub

Hedgehog 发表于 2022-7-6 09:55:27

很高兴你终于能让它工作了。。。。我通常检查&再次检查事情是否正常,但我昨天感觉不太好。。。
 
... & 感谢您点击链接。。。摄影是我的另一个爱好眨眼:

Arizona 发表于 2022-7-6 09:58:56

 
甜蜜的例行公事!它真的帮了我一把Ustn转换的多行文字,这是一个混乱!这帮我节省了一天的工作!
 
谢谢刺猬!!

Hedgehog 发表于 2022-7-6 09:59:57

没有,很高兴这有帮助…&很好,搜索功能正在发挥作用

gpetty46 发表于 2022-7-6 10:03:28

这条线索似乎是最新的,所以我会在这里问。
 
Ran StripMtext。lsp上周进行了多次,效果非常好。
今天我收到一条错误消息:
条纹文字
StripMtext v3.09
选择对象:找到1个
 
选择对象:
错误:自动化错误。没有数据库
 
知道这意味着什么吗?
提前感谢,
加里

Hedgehog 发表于 2022-7-6 10:06:34

尝试添加第二段新的多行文字?。。。它还会发生吗?。。。这会发生在其他图纸中吗?。。。可能是编程错误,而不是与您的设置有关。

CAB 发表于 2022-7-6 10:09:35

你可以试试我的脱衣舞女看看,它出错了。
见附件。
使用(strip\u text MyString'*')删除所有
文本条CAB30。LSP

gpetty46 发表于 2022-7-6 10:12:58

刺猬-是的,在任何绘画中都做同样的事情。仅供参考,我正在从PDF导入文本,该PDF将格式代码放在其中。
 
出租车-你的脱衣舞女也做同样的事。?!
 
这让我相信这是一个安装问题。这是新安装的AutoCAD2008,前几天我做了注册表清理,所以。。。。。。
我将卸载并重新安装AutoCAD,看看会发生什么。
 
谢谢你的帮助。我会告诉你发生了什么。
 
加里

Hedgehog 发表于 2022-7-6 10:16:56

但这是否只发生在PDF导入的文本上?。。。它可能只是遇到了一个它无法处理的代码。
页: 1 [2]
查看完整版本: 摆脱文本格式