Shoe_Cobbler Posted December 21, 2010 Share Posted December 21, 2010 Hi, Does anyone have a VBA function that will convert drawing text that's in feet, inches and fractions of an inch (5'-11 -1/2") into metric equivelent? I can't seem to find one. This would be for text only, not a dimension. Thanks. Quote Link to comment Share on other sites More sharing options...
SEANT Posted December 21, 2010 Share Posted December 21, 2010 This would work, but the text would have to be in a very specific format i.e.: 5'-11 1/2" Sub ToMetric() Dim entTxt As AcadText Dim dblmeasure As Double Dim varpkpt As Variant Dim ent As AcadEntity With ThisDrawing .Utility.GetEntity ent, varpkpt, "Select measure as text." If TypeOf ent Is AcadText Then Set entTxt = ent dblmeasure = .Utility.DistanceToReal(entTxt.TextString, acArchitectural) * 0.0254 Set entTxt = ThisDrawing.ModelSpace.AddText(CStr(dblmeasure) & " Meters", entTxt.InsertionPoint, entTxt.Height) ent.Delete End If End With End Sub Quote Link to comment Share on other sites More sharing options...
fixo Posted December 21, 2010 Share Posted December 21, 2010 Option Explicit ' --> request reference to Microsoft VBScript Regular Expression 5.5 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' Sub MerryXmass() 'from fixo' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' Dim s As String Dim i As Long Dim cnt As Integer Dim quotes As Integer Dim num As Double Dim regex As regexp Set regex = New regexp regex.IgnoreCase = True regex.Global = False cnt = 0 ''Tested: 's = "5 \ ' - 11 - 1/2\ """ 'ok ''s = "10 - 1/2\ """ 'ok s = "18/32\ """ 'ok Dim ar() As String Dim decs() As String If quotes = 1 And cnt = 2 Then regex.Pattern = "(\d+)(.*)(\d{1,2})(.*)(\d+)(/)(\d{1,2})(.*)$" s = regex.Replace(s, "$1;$3;$5;$7") MsgBox s ar = Split(s, ";", -1, 1) num = (CDbl(ar(0)) * 12 + (CDbl(ar(1)) + CDbl(ar(2)) / CDbl(ar(3)))) * 0.0254 ''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'' ElseIf quotes = 0 And cnt = 1 Then s = Replace(s, "-", ";", 1, -1, 1) s = Replace(s, Chr(34), "", 1, -1, 0) s = Replace(s, Chr(92), "", 1, -1, 0) ar = Split(s, ";", -1, 0) decs = Split(ar(1), "/", -1, 0) num = (CDbl(ar(0) + CDbl(decs(0)) / CDbl(decs(1)))) * 0.0254 ''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'' ElseIf quotes = 0 And cnt = 0 Then s = Replace(s, "/", ";", 1, -1, 1) s = Replace(s, Chr(34), "", 1, -1, 0) s = Replace(s, Chr(92), "", 1, -1, 0) decs = Split(s, ";", -1, 0) num = (CDbl(decs(0)) / CDbl(decs(1))) * 0.0254 ''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'' Else MsgBox "Unknown format" End If '' Set regex = Nothing Debug.Print num End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' Private Function CountChars(source As String, find As String) As Integer Dim i As Long Dim c As Long Dim ch As Integer ch = Asc(find) Dim x() As Byte x = StrConv(source, vbFromUnicode) For i = 0 To UBound(x) If x(i) = CByte(ch) Then c = c + 1 End If Next CountChars = c End Function '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' Merry Xmass *Seant* and all of the friends of mine from here Oleg Quote Link to comment Share on other sites More sharing options...
Shoe_Cobbler Posted December 22, 2010 Author Share Posted December 22, 2010 MerryXmas Fixo but I'm stuck on how to use MerryXmass. I'm almost certain it's what I'm looking for. What would you recommend I try to see how this will work with some AutoCAD text? Quote Link to comment Share on other sites More sharing options...
fixo Posted December 22, 2010 Share Posted December 22, 2010 (edited) I didn't check the project carefully, you make it ConvertFromImp.zip Edited December 22, 2010 by fixo added project Quote Link to comment Share on other sites More sharing options...
SEANT Posted December 22, 2010 Share Posted December 22, 2010 Merry Christmas, Fixo, my friend. I’ll have to study this use of Regular Expression; a nice gift for anyone, not just the original poster. Quote Link to comment Share on other sites More sharing options...
fixo Posted December 22, 2010 Share Posted December 22, 2010 Thanks so much , Sean, my friend Unfortunatelly, I have not enough time to write all condition using regular expression just the first one from them I'd like to wish you all of the best in new year Regards, Oleg Quote Link to comment Share on other sites More sharing options...
Shoe_Cobbler Posted December 23, 2010 Author Share Posted December 23, 2010 FaLaLaLaLa...LaLaLaLa. Thank you Fixo! Having much fun with your gift. Still tweeking it but had to let you know I'm thrilled so far. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.