RSMEANS Python REGEXP extractions

Attribute VB_Name = "RSUnits"
Option Explicit
''Constants for reference of unit types in RSMEANS
'' Floor, concrete, slab form, open web bar joist @ 2' OC, on W beam and wall, 30'x30' bay, 29" deep, 65 PSF superimposed load, 110 PSF total load, for columns add
Public Const VBQT = """"

''these use named regexp returns based in python
''Public Const Regex_BAY+PYTHON = "(?:(?P\d{1,})((?P\'|\" & VBQT & "|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\" & VBQT & "|ft|in)\W{0,}bay)"
Public Const Regex_BAY = "(?:([\d\.]{1,})((\'|\" & VBQT & "|ft|in))\W{0,}x\W{0,}(\d{1,})(\'|\" & VBQT & "|ft|in)\W{0,}bay)"
Public Const Regex_Addon = "(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}"
''Public Const Regex_SPACE+python = "(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\" & VBQT & "|ft|in)\W{0,}oc)))"
Public Const Regex_SPACE = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" & VBQT & "|ft|in)\W{0,}oc)))"
Public Const Regex_SPAN = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" & VBQT & "|ft|in)\W{0,}span)))"
''Public Const Regex_DEEP+PYTHON  = "(?:(?P\d{1,})(?P\'|\" & VBQT & "|ft|in)\W{0,}deep)"
Public Const Regex_DEEP = "(?:([\d\.]{1,})(\'|\" & VBQT & "|ft|in)\W{0,}deep)"
Public Const Regex_LOAD = "(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)"

'' full regexp with names regexp =  watch for VBQTs!
'' (?:(?P\d{1,})((?P\'|\"|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\"|ft|in)\W{0,}bay)|(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}|(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\"|ft|in)\W{0,}oc)))|(?:(?P\d{1,})(?P\'|\"|ft|in)\W{0,}deep)|(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)

Type Units
    BAY_X As Integer
    BAY_Y As Integer
    BAY_X_UNIT As String
    BAY_Y_UNIT As String
End Type
Function RSM_Val(strValue As String, Optional strType As String) As Variant
Dim rangeCaller As Range
Dim reg As New Regexp
Dim strl As String
Dim ret As MatchCollection

Dim strNumberFormat As String

''only returns one value at a time so only need to track one measurement except wxd for 'bay'
Dim Height As Single
Dim Width As Single
Dim Depth As Single
Dim UNIT As String


Dim Found As Boolean        ''for control over formatting
Found = False

    strl = LCase(strValue)
    strType = LCase(strType)
    Set rangeCaller = Application.Caller
   
    Select Case strType
        Case "bay"
            reg.Pattern = RSUnits.Regex_BAY
       
            Set ret = reg.Execute(strValue)
            If ret.Count > 0 Then
                Width = ret.Item(0).SubMatches.Item(0)
                If ret.Item(0).SubMatches.Item(1) = VBQT Then ret.Item(0).SubMatches.Item(1) = "''"  ''may not be needed returning text.
                Depth = ret.Item(0).SubMatches.Item(3)
                If ret.Item(0).SubMatches.Item(4) = VBQT Then ret.Item(0).SubMatches.Item(4) = "''"  ''may not be needed returning text.
               
                RSM_Val = Width & ret.Item(0).SubMatches.Item(1) & " x " & Depth & ret.Item(0).SubMatches.Item(4)
                UNIT = "General"
               
                rangeCaller.Cells(1, 1).HorizontalAlignment = xlCenter
                rangeCaller.Cells(1, 1).VerticalAlignment = xlCenter
                Found = True
            End If
        Case "bayx"
            reg.Pattern = RSUnits.Regex_BAY
       
            Set ret = reg.Execute(strValue)
            If ret.Count > 0 Then
                Width = ret.Item(0).SubMatches.Item(0)
                UNIT = ret.Item(0).SubMatches.Item(1)
                Depth = ret.Item(0).SubMatches.Item(3)
                strNumberFormat = "00" & VBQT & UNIT & VBQT
               
                RSM_Val = Width
               
                rangeCaller.Cells(1, 1).HorizontalAlignment = xlRight
                Found = True
            End If
        Case "bayy"
            reg.Pattern = RSUnits.Regex_BAY
       
            Set ret = reg.Execute(strValue)
            If ret.Count > 0 Then
                Depth = ret.Item(0).SubMatches.Item(3)
                UNIT = ret.Item(0).SubMatches.Item(4)
                RSM_Val = Depth
                rangeCaller.Cells(1, 1).HorizontalAlignment = xlRight
                Found = True
            End If
           
        Case "deep"
            reg.Pattern = RSUnits.Regex_DEEP
       
            Set ret = reg.Execute(strValue)
            If ret.Count > 0 Then
                Height = ret.Item(0).SubMatches.Item(0)
                UNIT = ret.Item(0).SubMatches.Item(1)
                RSM_Val = Height
                Found = True
            End If
       
    End Select

    If Found = True Then                                                '''Reset formatting
        FormatCell Application.Caller, UNIT
    Else                                                                ''''reset cell to general formatting
        RSM_Val = ""
        rangeCaller.NumberFormat = "General"
        rangeCaller.HorizontalAlignment = xlTop
        rangeCaller.VerticalAlignment = xlLeft
    End If
       
End Function

Private Sub FormatCell(xr As Range, UNIT As String)
Select Case UNIT
    Case VBQT, "''" ''inches
        UNIT = "00.00" & "''"
    Case "'"
        UNIT = "00" & "'"
    Case Else
        UNIT = "General"
End Select
    Sheet1.strNumberFormat = UNIT   ''trick to attempt force override on sheet value change
    xr.NumberFormat = UNIT
End Sub


Comments

Post a Comment

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Add text fields- this VBA searches through the objects in the first frame until it finds " " in the text some where, truncates everything from and to the right and replaces it with an active countdown timer or current time in the box. Refreshes every 500ms with a prtsafe call so it doesn't bog down the CPU. Add a slide advance to start the next slide and begin automated slide advancement. Attribute VB_Name = "Countdown" Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long Public Sub Wait ( Seconds As Double ) ''non cpu-intensive wait timer '' https://stackoverflow.com/questions/57268161/sleep-wait-timer-in-powerpoint-vba-thats-not-cpu-intensive Dim endtime As Double endtime = DateTime.Timer + Seconds Do WaitMessage DoEvents Loop While DateTime.Timer < endtime End Sub Sub Countdown_from_Start () Dim Time As Date Dim Count As ...
Read more

Revit area plans adding new types and references (Gross and rentable)

Image
Note to self: Add additional (duplicate) gross area and net area schemed under Area Plans And Area schemes... Really counter-intuitive place to put this instead of say...  Area Plans> New Type> Edit Type (ADD) or Create an area plan, then Go to Properties, Edit Type and Duplicate... Always seem to forget this one! 2015-10-16-And for the calculation type... To update: this also applies to Revit as well as LT- The gross calculations cannot be overridden, however the 'rentable' comes in various flavors... From AD Revit help: Applies to Revit LT 2015 Rules are determined by one type of space bordering another space. The following table shows area measurement rules. To find the appropriate measurement rule, find the selected Area Type and the corresponding Bordering Area Type. Gross Building Area Scheme Types Gross Building Area Scheme Types Area Type Selected Bordering Area Type Measurement Rule Gross Building Area Gross Buil...
Read more