Function RimParameters(ByVal txt$, Optional ByVal Result& = 0) As String
On Error Resume Next
' возвращает значение в зависимости от параметра Result&:
' 0 - полный типоразмер, 1 - диаметр диска (DIAM), 2 - ширина диска (WID), 3 - вылет диска (ET),
' 4 - количество болтов (WHOLES), 5 - диаметр окружности болтов (PCD - Pitch Circle Diameter),
' 6 - разболтовка (BC*PCD), 7 - диаметр отверстия (Centerbore), 8 - цвет (COLOR)
Dim WID$, PROF$, DIAM$, ET$, WHOLES$, PCD$, CENTERBORE$, COLOR$
Dim pattern_index&: pattern_index& = -1
Static REGEXP As Object
If REGEXP Is Nothing Then Set REGEXP = CreateObject("VBScript.RegExp"): REGEXP.Global = True
txt$ = Application.Trim(txt$): txt$ = Replace(txt$, ".", ","): txt$ = Replace(txt$, "ЕТ", "ET"): txt$ = Replace(txt$, "DIA", "D")
txt$ = Replace(txt$, "x ", "`` "): txt$ = Replace(txt$, "х ", "`` "): txt$ = Replace(txt$, ",0,0", ",0")
txt$ = Replace(txt$, "x", "*"): txt$ = Replace(txt$, "х", "*"): txt$ = Replace(txt$, ";", " ")
' Буква J – указывает на наличие одного буртика (хампа). Вместо может так же использоваться маркировка H,Н2,FH,AH
For Each v In Array("J*", "FH*", "AH*", "H2*", "H*"): txt$ = Replace(txt$, v, "*"): Next
'txt$ = Replace(txt$, "/98", "*98"): txt$ = Replace(txt$, "/1", "*1")
REGEXP.Pattern = "/98(\D)": If REGEXP.test(txt$) Then txt$ = REGEXP.Replace(txt$, "*98$1")
REGEXP.Pattern = "(\d)/1(\d{2})(\D)": If REGEXP.test(txt$) Then txt$ = REGEXP.Replace(txt$, "$1*1$2$3")
txt$ = Replace(txt$, "/", " ")
txt$ = Replace(txt$, "* ", "*"): txt$ = Replace(txt$, " *", "*"): txt$ = Replace(txt$, Chr(160), " "): txt$ = Replace(txt$, "|", " ")
txt = " " & Replace(Replace(txt, "(", " ( "), ")", " ) ") & " "
' вылет диска
REGEXP.Pattern = " ET(\d{1,2},\d|\d{1,2})|ET-(\d{1,2},\d|\d{1,2}) "
If REGEXP.test(txt$) Then
ET$ = Trim(Split(REGEXP.Execute(txt$).item(0).value, "ET")(1))
End If
' диаметр отверстия (Centerbore)
REGEXP.Pattern = " D(\d{2,3},\d|\d{2,3}) "
If REGEXP.test(txt$) Then
CENTERBORE$ = Trim(Split(REGEXP.Execute(txt$).item(0).value, "D")(1))
Else
REGEXP.Pattern = " (\d{2,3},\d|\d{2,3}) "
If REGEXP.test(txt$) Then
CENTERBORE$ = Trim(REGEXP.Execute(txt$).item(0).value)
End If
End If
' разболтовка
REGEXP.Pattern = " (3|4|5|6|8|10)\*(98|(\d{3},\d|\d{3})) "
If REGEXP.test(txt$) Then
res$ = Trim(REGEXP.Execute(txt$).item(0).value)
WHOLES$ = Split(Replace(res$, "/", "*"), "*")(0)
PCD$ = Split(Replace(res$, "/", "*"), "*")(1)
Else ' двойная разболтовка типа 10*100*114,3
REGEXP.Pattern = " (3|4|5|6|8|10)\*(98|(\d{3},\d|\d{3})\*(98|(\d{3},\d|\d{3})) "
REGEXP.Pattern = " (6|8|10)\*(\d{3},\d|\d{3})\*(\d{3},\d|\d{3}) "
If REGEXP.test(txt$) Then
res$ = Trim(REGEXP.Execute(txt$).item(0).value)
WHOLES$ = Split(Replace(res$, "/", "*"), "*")(0)
PCD$ = Split(Replace(res$, "/", "*"), "*", 2)(1)
End If
End If
' ширина и диаметр (могут идти в любом порядке)
REGEXP.Pattern = " [12][0-9]\*([3-9]|[3-9],5|[3-9],[27]5|1[0-3]|1[0-3],5) "
If REGEXP.test(txt$) Then
res$ = Trim(REGEXP.Execute(txt$).item(0).value)
DIAM$ = Split(Replace(res$, "/", "*"), "*")(0)
WID$ = Split(Replace(res$, "/", "*"), "*")(1)
Else
REGEXP.Pattern = " ([3-9]|[3-9],0|[3-9],5|[3-9],[27]5|1[0-3]|1[0-3],5|1[0-3],[27]5)\*[12][0-9] "
If REGEXP.test(txt$) Then
res$ = Trim(REGEXP.Execute(txt$).item(0).value)
WID$ = Split(Replace(res$, "/", "*"), "*")(0)
DIAM$ = Split(Replace(res$, "/", "*"), "*")(1)
Else
REGEXP.Pattern = " R[12][0-9] "
If REGEXP.test(txt$) Then
res$ = Trim(REGEXP.Execute(txt$).item(0).value)
WID$ = ""
DIAM$ = Split(res$, "R")(1)
End If
End If
End If
' цвет
REGEXP.Pattern = "\b[A-z]{1,6}\b"
color_txt$ = Replace(Replace(Replace(txt, "(", " ("), ")", ") "), ",", " ") & " "
If REGEXP.test(color_txt$) Then
Set a = REGEXP.Execute(color_txt$)
COLOR$ = UCase(Trim(REGEXP.Execute(color_txt$).item(REGEXP.Execute(color_txt$).Count - 1).value))
End If
FULL_TEXT$ = Application.Trim(Replace(WID$ & "*" & DIAM$ & " / " & WHOLES$ & "*" & PCD$ & " ET" & ET$ & " D" & CENTERBORE$ & " " & COLOR$, "*", "x"))
If Len(WID$) + Len(DIAM$) + Len(WHOLES$) + Len(PCD$) = 0 Then FULL_TEXT$ = ""
RimParameters = Choose(Result& + 1, FULL_TEXT$, DIAM$, WID$, ET$, WHOLES$, PCD$, IIf(Len(WHOLES$) * Len(PCD$), WHOLES$ & "*" & PCD$, ""), CENTERBORE$, COLOR$)
End Function
|