Feet Inches to metric

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.

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

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

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?

I didn't check the project carefully, you make it

ConvertFromImp.zip

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.

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

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.