Сравнение строк примитивов TEXT и MTEXT с одинаковым смысловым содержимым

Керн · 23.11.2024, 22:02

Доброго времени всем форумчанам!
Ранее при работе в файле autocad сравнивал строки текстовых примитивов TEXT простой самописной функцией, игнорировался только пробел

(defun text ( t1 t2 / )
(=
(vl-list->string(vl-remove 32(vl-string->list(cdr(assoc 1(entget(handent t1)))))))
(vl-list->string(vl-remove 32(vl-string->list(cdr(assoc 1(entget(handent t2)))))))
)
)

но тут встал вопрос о сравнении TEXT и MTEXT в произвольной последовательности, т.е. вместо t1 и t2 произвольно может быть любой из примитивов. Не будучи знатоком lisp и программистом, просто опускаются руки, смотрю ф-цию wcmatch, но что не догоню... В поиске искал, но оказывается правильно заданный вопрос тоже непростой навык. Есть ли какие ни будь варианты решения проблемы, vl и vla даже не знаю и честно лезть туда просто нет времени. Но может есть просто волшебная функция, в которую знатокам не составит труда меня в неё ткнуть

name02 · 25.11.2024, 08:29

Увы универсальной функции нет. Можно попробовать такую:

Код:

[Выделить все]

 (defun c:EQT (/ t1 t2 ay_getTextString LM:UnFormat)
  (vl-load-com)

  ;;-------------------=={ UnFormat String }==------------------;;
  ;;                                                            ;;
  ;;  Returns a string with all MText formatting codes removed. ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  str - String to Process                                   ;;
  ;;  mtx - MText Flag (T if string is for use in MText)        ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  String with formatting codes removed            ;;
  ;;------------------------------------------------------------;;

  (defun LM:UnFormat (str mtx / _replace rx)

    (defun _replace (new old str)
      (vlax-put-property rx 'pattern old)
      (vlax-invoke rx 'replace str new)
    ) ;_ end defun
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
      (progn
        (setq str
               (vl-catch-all-apply
                 (function
                   (lambda ()
                     (vlax-put-property rx 'global actrue)
                     (vlax-put-property rx 'multiline actrue)
                     (vlax-put-property rx 'ignorecase acfalse)
                     (foreach pair
                              '(
                                ("\032" . "\\\\\\\\")
                                (" " . "\\\\P|\\n|\\t")
                                ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
                                ("$1" . "[\\\\]({)|{")
                               )
                       (setq str (_replace (car pair) (cdr pair) str))
                     ) ;_ end foreach
                     (if mtx
                       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                       (_replace "\\" "\032" str)
                     ) ;_ end if
                   ) ;_ end lambda
                 ) ;_ end function
               ) ;_ end vl-catch-all-apply
        ) ;_ end setq
        (vlax-release-object rx)
        (if (null (vl-catch-all-error-p str))
          str
        ) ;_ end if
      ) ;_ end progn
    ) ;_ end if
  ) ;_ end defun




  (defun ay_getTextString (ent /)

    (cond
      ((= (cdr (assoc 0 (entget ent))) "MTEXT")
       (LM:UnFormat (cdr (assoc 1 (entget ent))) t)
      )
      ((= (cdr (assoc 0 (entget ent))) "TEXT")
       (LM:UnFormat (cdr (assoc 1 (entget ent))) nil)
      )
      (T nil)

    ) ;_ end cond
  ) ;_ end defun


  (setq t1 (car (entsel "\nВыберите первый текстовый объект: ")))

  (setq t2 (car (entsel "\nВыберите второй текстовый объект: \n")))


  (= (ay_getTextString t1)
     (ay_getTextString t2)
  ) ;_ end =


) ;_ end defun

koMon · 25.11.2024, 11:22

Цитата:

Сообщение от Керн

сравнивал строки текстовых примитивов TEXT простой самописной функцией

для функции (text t1 t2), которая сравнивает строки, полученные из списков номеров символов кроме пробелов, полученные из строк примитивов, абсолютно без разницы какой примитив будет первым или вторым...

Керн · 25.11.2024, 13:44

name02, Большое спасибо! буду пробовать и проверь. по результату отпишусь. Честно говоря так и знал что краями не разойдусь, и тут
всякие vlax...

----- добавлено через ~2 мин. -----

Цитата:

Сообщение от koMon

для функции (text t1 t2), которая сравнивает строки, полученные из списков номеров символов кроме пробелов, полученные из строк примитивов, абсолютно без разницы какой примитив будет первым или вторым...

да. когда сравниваем TEXTы нет разницы в чередовании, но когда влазиет произвольно MTEXT...

name02 · 25.11.2024, 15:33

Цитата:

Сообщение от Керн

но когда влазиет произвольно MTEXT...

Дело не в МТЕХТ как таковом, причина "неправильной" работы твоей функции может быть в том, что визуально такой же МТЕКСТ может содержать в себе спецсимволы форматирования (угол наклона текста, перенос строки, цвет и т.п.). Поэтому удалив из текстовой строки только пробелы ты все равно будешь сравнивать разные по содержанию объекты

Керн · 25.11.2024, 16:08

Цитата:

Сообщение от name02

Дело не в МТЕХТ как таковом, причина "неправильной" работы твоей функции может быть в том, что визуально такой же МТЕКСТ может содержать в себе спецсимволы форматирования (угол наклона текста, перенос строки, цвет и т.п.). Поэтому удалив из текстовой строки только пробелы ты все равно будешь сравнивать разные по содержанию объекты

Да, вы правы, собственно поэтому и обратился к знатокам, если для сверки TEXTов меня хватило, то для сверки даже одинаковых по смысловой нагрузке MTEXTтов, я уже пасовал. Человеческому глазу, содержание
будет идентичным, а для сравнения в LISPe e МTEXTа куча сопутствующей атрибутной информации, и мне совсем не очевидно как это сделать, я конечно понимаю что возможно но...

----- добавлено через ~44 мин. -----
name02, попробовал предложенный вами код, не работает т.к. надо, при сверке 2 мтекстов, не игнорируются пробелы. то же при сравнении, текста и мтекста. Будем искать дальше

Сергей812 · 25.11.2024, 18:58

деформатируйте содержимое мультитекста, а дальше работайте со строками.

===AAA=== · 26.11.2024, 05:49

Цитата:

... с одинаковым смысловым содержимым

Если ставить вопрос именно так, то не забудьте о том, что
пары русских и английских символов, типа H/Н, Х/X и прочих
выглядят одинаково. C/С - это вообще классика жанра, т.к.
они на одной клавише расположены. Да и "ноль" буквой "О"
(русской или английской) заменят, как здрасьте.
Проектировщики - они такие затейники...

name02 · 26.11.2024, 07:29

Цитата:

Сообщение от Сергей812

деформатируйте содержимое мультитекста, а дальше работайте со строками.

Эта функция только знаки форматирования убирает. Символы переноса строки не удаляются

Цитата:

Сообщение от Керн

при сверке 2 мтекстов, не игнорируются пробелы. то же при сравнении, текста и мтекста. Будем искать дальше

Ломоносов из Холмогор в Москву дошел, а ты до решения своей задачи одного шага не дошел...

Код:

[Выделить все]

  (defun c:EQT (/ t1 t2 ay_getTextString LM:UnFormat)
  (vl-load-com)

  ;;-------------------=={ UnFormat String }==------------------;;
  ;;                                                            ;;
  ;;  Returns a string with all MText formatting codes removed. ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  str - String to Process                                   ;;
  ;;  mtx - MText Flag (T if string is for use in MText)        ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  String with formatting codes removed            ;;
  ;;------------------------------------------------------------;;

  (defun LM:UnFormat (str mtx / _replace rx)

    (defun _replace (new old str)
      (vlax-put-property rx 'pattern old)
      (vlax-invoke rx 'replace str new)
    ) ;_ end defun
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
      (progn
        (setq str
               (vl-catch-all-apply
                 (function
                   (lambda ()
                     (vlax-put-property rx 'global actrue)
                     (vlax-put-property rx 'multiline actrue)
                     (vlax-put-property rx 'ignorecase acfalse)
                     (foreach pair
                              '(
                                ("\032" . "\\\\\\\\")
                                (" " . "\\\\P|\\n|\\t")
                                ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
                                ("$1" . "[\\\\]({)|{")
                               )
                       (setq str (_replace (car pair) (cdr pair) str))
                     ) ;_ end foreach
                     (if mtx
                       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                       (_replace "\\" "\032" str)
                     ) ;_ end if
                   ) ;_ end lambda
                 ) ;_ end function
               ) ;_ end vl-catch-all-apply
        ) ;_ end setq
        (vlax-release-object rx)
        (if (null (vl-catch-all-error-p str))
          str
        ) ;_ end if
      ) ;_ end progn
    ) ;_ end if
  ) ;_ end defun




  (defun ay_getTextString (ent /)

    (cond
      ((= (cdr (assoc 0 (entget ent))) "MTEXT")
       (LM:UnFormat (cdr (assoc 1 (entget ent))) t)
      )
      ((= (cdr (assoc 0 (entget ent))) "TEXT")
       (LM:UnFormat (cdr (assoc 1 (entget ent))) nil)
      )
      (T nil)

    ) ;_ end cond
  ) ;_ end defun


  (setq t1 (car (entsel "\nВыберите первый текстовый объект: ")))
  (setq t2 (car (entsel "\nВыберите второй текстовый объект: \n")))

  (= (vl-list->string (vl-remove 32 (vl-string->list (ay_getTextString t1))))
     (vl-list->string (vl-remove 32 (vl-string->list (ay_getTextString t2))))

  ) ;_ end =


) ;_ end defun

Керн · 26.11.2024, 12:12

name02, да, этот код, при первичной проверке, работает как я представлял!

Цитата:

Сообщение от ===AAA===

Если ставить вопрос именно так, то не забудьте о том, что
пары русских и английских символов, типа H/Н, Х/X и прочих
выглядят одинаково. C/С - это вообще классика жанра, т.к.
они на одной клавише расположены. Да и "ноль" буквой "О"
(русской или английской) заменят, как здрасьте.
Проектировщики - они такие затейники...

о дааа, но туда я не полезу

это прям из разряда диверсии!

----- добавлено через ~3 мин. -----

Цитата:

Сообщение от name02

Ломоносов из Холмогор в Москву дошел, а ты до решения своей задачи одного шага не дошел...

и не удивительно, я даже близко не Ломоносов.
Спасибо, ваш последний код, при первичной проверке, работает как я себе представлял!

Керн · 03.12.2024, 15:32

Укажите направление куда копать, если нужно ф-ей ssget выбрать набор из файла dwg, который лежит на диске и при этом закрыт.
есть ли такая возможность вообще?

Сергей812 · 03.12.2024, 15:47

Цитата:

Сообщение от Керн

если нужно ф-ей ssget выбрать набор из файла dwg, который лежит на диске и при этом закрыт.

из закрытого файла еще никому не удавалось считать содержимое) А так читайте про ObjectDBX, например это

Керн · 04.12.2024, 09:26

спасибо! понял, принял.

23.11.2024, 22:02		#1
Сравнение строк примитивов TEXT и MTEXT с одинаковым смысловым содержимым Керн Регистрация: 23.11.2024 Сообщений: 6 Доброго времени всем форумчанам! Ранее при работе в файле autocad сравнивал строки текстовых примитивов TEXT простой самописной функцией, игнорировался только пробел (defun text ( t1 t2 / ) (= (vl-list->string(vl-remove 32(vl-string->list(cdr(assoc 1(entget(handent t1))))))) (vl-list->string(vl-remove 32(vl-string->list(cdr(assoc 1(entget(handent t2))))))) ) ) но тут встал вопрос о сравнении TEXT и MTEXT в произвольной последовательности, т.е. вместо t1 и t2 произвольно может быть любой из примитивов. Не будучи знатоком lisp и программистом, просто опускаются руки, смотрю ф-цию wcmatch, но что не догоню... В поиске искал, но оказывается правильно заданный вопрос тоже непростой навык. Есть ли какие ни будь варианты решения проблемы, vl и vla даже не знаю и честно лезть туда просто нет времени. Но может есть просто волшебная функция, в которую знатокам не составит труда меня в неё ткнуть
Просмотров: 981

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)	Red Nova	LISP	5021	вчера 17:50
Нужен лисп, который высчитывает уклон линии	ВоваН	LISP	53	02.06.2021 10:09
Как создать TEXT, MTEXT с содержимым, равным значению атрибутов объекта	rouble	AutoCAD	2	12.08.2015 14:24
AUTOCAD 2010 перестал переключаться в многооконный режим. Проблемы с переменными	Андрей Х.	AutoCAD	24	27.05.2015 10:17
Acaddoc.lsp - насколько вредный	Alexander88	LISP	1	10.06.2014 09:29