Может у кого есть скрипт склонения по падежам?

Gandliar

Gandliar

Lotus team
16.02.2004
406
14
Если не жалко, может поделитесь? :)
 
oshmianski

oshmianski

Достойный программист
Lotus team
25.04.2012
633
33
когда-то давно пробовал работать с библиотекой. windows only, т.к. dll.
в приложенной бд см. библиотеку lib.Padeg.
 

Вложения

lmike

lmike

нет, пердело совершенство
Lotus team
27.08.2008
7 256
439


сам не тестил
т.к. java - нет ограничений по платформе!
 
savl

savl

Lotus team
28.10.2011
2 249
136
Я пробовал код с форума: https://codeby.net/threads/sklonenie-fio-i-dolzhnosti-vo-vsex-padezhax.45572/
Там последний комментарий самый верный: вбивать руками.
Должности еще прокатят, но если Вам необходимо это для ФИО - лучше все поля вбивать руками, ибо доля ошибки есть...
Заполнять по умолчанию можно, но нежелательно, так как пользователи будут просто лениться вносить исправления.
Мы в кадровой системе сделали поля и HR вводил сам информацию от сотрудника, никакого автомата.
Затем везде брались эти данные для рассылок, информации, документов и тд
 
Gandliar

Gandliar

Lotus team
16.02.2004
406
14
Спасибо всем кто откликнулся. Ваяю программу для настройки контекстной рекламы, вот и понадобились падежи для слов и минус-слов.

И да, принцип записал слово в именительном падеже, получил единственное и множественное число во всех падежах, глазками проверил и сохранил в базе.
 
K

Kmet

Java Team
25.05.2006
904
8
я бы еще посмотрел словари c и проекты которые используют их ( и тд)
 
M

MaxP

Well-known member
02.12.2014
54
1
Есть библиотека, склоняющая в род. падеж. Иногда выдает неверный результат. Если подправите, и выложите, буду благодарен.
Код:
%REM
    Library Declination
    Created Nov 3, 2014
    Description: Comments for Library
%END REM
Option Public


Option Compare Text    ' эта строка нужна обязательно! (сравнение без учёта регистра)
Sub Terminate
    
End Sub


Function GetGenitiveException(ByVal txt$) As String    ' склонение имён-исключений
   Select Case txt$
        Case "Павел": GetGenitiveException = "Павла"
        Case "Лев": GetGenitiveException = "Льва"
        Case "Пётр": GetGenitiveException = "Петра"
        Case "Любовь": GetGenitiveException = "Любови"
           Case "Первый": GetGenitiveException = "Первого"

            ' без изменения (не склоняются) - перечисляем через запятую
       Case "Али", "Бали": GetGenitiveException = txt$
    End Select
End Function

Function GenitiveCase(sSurname,sName,sPatronymic) As String
    ' Функция формирует родительный падеж из ФИО
    ' Параметры: sSurname - фамилия, sName - имя, sPatronymic - отчество
    ' © 2013 EducatedFool

    sSurname = Replace(sSurname, " - ", "-"): sSurname = Replace(Replace(sSurname, " -", "-"), "- ", "-")

    On Error Resume Next
    If sName = "" And sPatronymic = "" Then
        arr = sSurname
        sSurname = arr(0): sName = arr(1): sPatronymic = Replace(arr(2), ".", "")
    End If

    ' пол теперь определяется иначе:   что заканчивается на "вна" или "кызы" - то женщины, остальные - мужчины.
    Dim bMaleSex As Boolean:    ' bMaleSex = (Right(sPatronymic, 1) = "ч" Or Right(sPatronymic, 4) = "оглы")
    bMaleSex = Not (Right(sPatronymic, 2) = "на" Or Right(sPatronymic, 4) = "кызы")

    If Len(sSurname) > 0 Then    '   Фамилия
        arrSurname = Split(sSurname, "-")
        For i = LBound(arrSurname) To UBound(arrSurname)    ' перебираем все части фамилий, содержащих дефис
            sRes = "": sSurnamePart = arrSurname(i)

            If bMaleSex Then    ' мужские фамилии
                Select Case Right(sSurnamePart, 1)
                Case "о", "и", "ы", "у", "э", "е", "ю": sRes = sSurnamePart
                Case "й": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ого"
                Case "ь": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "я"
                Case "я": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "и"
                Case "а": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ы"
                    If UBound(arrSurname) > 0 And i = 0 Then sRes = sSurnamePart
                Case Else: sRes = sSurnamePart & "а"
            End Select

                Select Case Right(sSurnamePart, 2)    ' добавлено, для редких фамилий
                Case "ец":  sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ца"
                    If LCase(sSurnamePart) Like "*[уеыаоэяиюё]ец" Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ца"
                    If LCase(sSurnamePart) Like "*[!уеыаоэяиюё][!уеыаоэяиюё]ец" Then sRes = sSurnamePart & "а"
                Case "зе", "их", "ых": sRes = sSurnamePart
                Case "ий", "ой": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ого"
                    If Len(sSurnamePart) <= 4 Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "я"
                    If Right(sSurnamePart, 3) = "чий" Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "его"
                Case "уй": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "уя"
            End Select

            Else    ' женские фамилии
                Select Case Right(sSurnamePart, 1)
                Case "о", "е", "э", "и", "ы", "у", "ю", "б", "в", "г", "д", "ж", "з", "к", "л", "м", "н", "п", _
                "р", "с", "т", "ф", "х", "ц", "ч", "ш", "щ", "ь", "й": sRes = sSurnamePart
                Case "а": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ой"
                Case "я": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ю"
                Case Else: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "у"
            End Select

                Select Case Right(sSurnamePart, 2)    ' добавлено, для редких фамилий
                Case "ха": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "хи"
                Case "ла": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "лы"
                Case "ая": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ой"
            End Select

            End If

            ' не склоняются мужские и женские фамилии, оканчивающиеся на -о, -е, -э, -и, -ы, -у, -ю,
            ' а также на -а с предшествующей гласной
            If LCase(sSurnamePart) Like "*[уеыаоэяиюё]а" Then sRes = sSurnamePart

            arrSurname(i) = sRes
        Next
        GenitiveCase = Join(arrSurname, "-") & " "    ' соединяем части склоняемой фамилии обратно в одну строку
    End If

    If Len(sName) > 0 Then    '   Имя
        NameException = GetGenitiveException(sName)
        If Len(NameException) Then    ' для имен-исключений
            GenitiveCase = GenitiveCase & NameException
        Else    ' имя не найдено в списке исключений
            If bMaleSex Then
                Select Case Right(sName, 1)
                Case "й", "ь": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "я"
                Case "а": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "ы"
                Case "я": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
                Case "о": GenitiveCase = GenitiveCase & sName
                Case Else: GenitiveCase = GenitiveCase & sName & "а"
            End Select
            Else
                Select Case Right(sName, 1)
                Case "а": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "ы"
                Case "я": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
                Case Else: GenitiveCase = GenitiveCase & sName
            End Select
            End If
        End If
        GenitiveCase = GenitiveCase & " "
    End If

    If Len(sPatronymic) > 0 Then    '   Отчество
        If Right(sPatronymic, 4) = "оглы" Or Right(sPatronymic, 4) = "кызы" Then
            GenitiveCase = GenitiveCase & sPatronymic
        Else
            If bMaleSex Then
                GenitiveCase = GenitiveCase & sPatronymic & "а"
            Else
                GenitiveCase = GenitiveCase & Mid(sPatronymic, 1, Len(sPatronymic) - 1) & "ы"
            End If
        End If
    End If
    GenitiveCase = Replace(GenitiveCase, "-", "- ")
    GenitiveCase = StrConv(GenitiveCase, vbProperCase)
    GenitiveCase = Replace(GenitiveCase, "- ", "-")
    GenitiveCase = FullTrim(GenitiveCase)
End Function
 
Мы в соцсетях:  ТелеграмВконтактеДзенФейсбукТвиттерЮтуб