Регулярные выражения в AutoLISP

Иногда наступают моменты, когда обычного wcmatchдля поиска совпадений уже недостаточно, а использовать новые средства разработки нельзя/затратно/нет знаний (нужное подчеркнуть). Так как я более 3-х лет в свободное время увлекаюсь программированием под Linux, то уже не представляю поиск по строкам без регулярных выражений. Но, раз основная работа связана с AutoCAD и AutoLISP, приходится искать другие инструменты решения задач.
В случае с регулярными выражениями на помощь приходит объект VBScript.RegExp, являющийся стандартным объектом VBScript 5 (%windir%\system32\vbscript.dll).
Что такое регулярные выражения, читаем здесь.
Описания и примеры VBScript.RegExp на VBScript можно почитать здесь.

Если интерес не пропал, смотрим, как это все дело прикрутить к AutoLISPу.

Для начала напишем функцию, регистрирующую объект VBScript.RegExp и возвращающего ссылку на него.

;;; <LISPDOC>
;;; <SUBR>(regexp-regapp)</SUBR>
;;; <DESC>Get VBScript.RegExp pointer</DESC>
;;; <RET>VBScript.RegExp pointer</RET> 
;;; </LISPDOC>
(defun regexp-regapp (/)
  (vla-getinterfaceobject (vlax-get-acad-object) "VBScript.RegExp"))

Теперь, когда у нас есть ссылка на объект можно приступать к созданию оберток к его методам:
Объект VBScript.Regexp содержит следующие методы:
Test - Сравнение текста с заданным шаблоном
Replace - Замена подстроки, соответствующей шаблону
Execute - Извлечение текста, заданного шаблоном
И свойства этого объекта:
Global - Проверка по всему тексту (True) или до первого соответствия (False)
IgnoreCase - Игнорировать регистр (True) или учитывать (False)
Pattern - Шаблон искомой подстроки (собственно регулярное выражение)
Multiline - Многострочный (True) или однострочный объект (False)

Мне потребовались 3 функции-обертки, приведу их ниже:

Сравнение текста с шаблоном (результат - T или nil):

;;; <LISPDOC>
;;; <SUBR>(regexp-match regexp_object pattern test_string is_global case_sensitive)</SUBR>
;;; <DESC>Test string match with Regexp</DESC> 
;;; <ARG>regexp_object - VBScript.RegExp pointer</ARG> 
;;; <ARG>pattern - regexp pattern</ARG> 
;;; <ARG>test_string - string to test</ARG> 
;;; <ARG>is_global - global match key (g)</ARG> 
;;; <ARG>case_sensitive - case sensitive key (i)</ARG> 
;;; <RET>T if matches \ nil otherwise</RET> 
;;; </LISPDOC> 
(defun regexp-match (regexp_object pattern test_string is_global case_sensitive / result) 
  (if regexp_object 
    (progn 
      (vlax-put regexp_object 'Pattern pattern) 
      (vlax-put regexp_object 'Global (if is_global acTrue acFalse)) 
      (vlax-put regexp_object 'IgnoreCase (if case_sensitive acFalse acTrue)) 
      (setq result (vlax-invoke regexp_object 'Test test_string)) 
      (vlax-put regexp_object 'Pattern ""))) 
  (if (and result (/= result 0)) 
    T 
    nil))

Замена подстроки (результат - новая строка):

;;; <LISPDOC> 
;;; <SUBR>(regexp-replace regexp_object pattern replace_string test_string is_global case_sensitive)</SUBR> 
;;; <DESC>Replace Regexp pattern with string</DESC> 
;;; <ARG>regexp_object - VBScript.RegExp pointer</ARG> 
;;; <ARG>pattern - regexp pattern</ARG> 
;;; <ARG>replace_string - string replacement</ARG>
;;; <ARG>test_string - string to test</ARG> 
;;; <ARG>is_global - global match key (g)</ARG> 
;;; <ARG>case_sensitive - case sensitive key (i)</ARG> 
;;; <RET>String after replace</RET> 
;;; </LISPDOC> 
(defun regexp-replace (regexp_object pattern replace_string test_string is_global case_sensitive / result) 
  (if regexp_object 
    (progn 
      (vlax-put regexp_object 'Pattern pattern) 
      (vlax-put regexp_object 'Global (if is_global acTrue acFalse)) 
      (vlax-put regexp_object 'IgnoreCase (if case_sensitive acFalse acTrue)) 
      (setq result (vlax-invoke regexp_object 'Replace test_string replace_string)) 
      (vlax-put regexp_object 'Pattern ""))) 
  result)

Извлечение текста по шаблону (результат - список элементов '(("Значение" Индекс Длина)))

;;; <LISPDOC>
;;; <SUBR>(regexp-execute regexp_object pattern test_string is_global case_sensitive)</SUBR> 
;;; <DESC>Execute regexp and return collection of found strings</DESC> 
;;; <ARG>regexp_object - VBScript.RegExp pointer</ARG> 
;;; <ARG>pattern - regexp pattern</ARG> 
;;; <ARG>test_string - string to test</ARG> 
;;; <ARG>is_global - global match key (g)</ARG> 
;;; <ARG>case_sensitive - case sensitive key (i)</ARG> 
;;; <RET>List of found strings ((String Index Length)...)</RET> 
;;; </LISPDOC> 
(defun regexp-execute (regexp_object pattern test_string is_global case_sensitive / result collection)
  (if regexp_object 
    (progn 
      (vlax-put regexp_object 'Pattern pattern) 
      (vlax-put regexp_object 'Global (if is_global acTrue acFalse)) 
      (vlax-put regexp_object 'IgnoreCase (if case_sensitive acFalse acTrue))  
      (setq collection (vlax-invoke regexp_object 'Execute test_string)) 
      (vlax-put regexp_object 'Pattern ""))) 
      (vlax-for item collection 
        (setq result 
          (cons 
            (list 
              (vlax-get item 'Value) 
              (vlax-get item 'FirstIndex) 
              (vlax-get item 'Length)) 
          result))))

Ну и пара примеров как итог:

_$ (setq reg (regexp-regapp))
_$ (regexp-match reg "\\d{3}-\\d{3}" "Phone: 333-444" T nil)
T
_$ (regexp-replace reg "\\s{2,}" " " "There     are    a lot of    spaces in string" T nil)
"There are a lot of spaces in string"
_$ (regexp-execute reg "\\d{3}-\\d{3}" "Home Number: 333-444; Work Number: 444-333" T nil)
(("444-333" 35 7) ("333-444" 13 7))