• На форуме с 27 августа 2009г.
  • Сообщений: 1
  • Спасибо: 0

Тема: Помогите пожалуйста найти ошибку в коде который убирает форматирование MTEXT

Добрый день,

Есть код который убирает форматирование у MTEXT, но он не может справится с форматированными списками как например:

    * ыв
    * ываываы
    * ываыва

В результате выдает бредовый набор символов

Сам код вот:

(defun remove-mtext-formatting
       (mtext-value / text-value temp-string)
      (setq text-value "")
      (while (/= mtext-value "")
    (cond
      ((wcmatch (strcase (setq temp-string (substr mtext-value 1 2)))
            "\\[\\{}]"
       )
       (setq mtext-value (substr mtext-value 3)
         text-value  (strcat text-value temp-string)
       )
      )
      ((wcmatch (substr mtext-value 1 1) "[{}]")
       (setq mtext-value (substr mtext-value 2))
      )
      ((wcmatch (strcase (setq temp-string (substr mtext-value 1 2)))
            "\\[LO`~]"
       )
       (setq mtext-value (substr mtext-value 3))
      )
      ((wcmatch (strcase (substr mtext-value 1 2)) "\\[ACFHQTW]")
       (setq mtext-value
          (substr mtext-value
              (+ 2 (vl-string-search ";" mtext-value))
          )
       )
      )
      ((wcmatch (strcase (substr mtext-value 1 4))
            "\\PQ[CRJD],\\PXQ"
       )
       (setq mtext-value
          (substr mtext-value
              (+ 2 (vl-string-search ";" mtext-value))
          )
       )
      )
      ((wcmatch (strcase (substr mtext-value 1 2)) "\\P")
       (if (or
         (zerop (strlen text-value))
         (= " " (substr text-value (strlen text-value)))
         (= " " (substr mtext-value 3 1))
           )
         (setq mtext-value (substr mtext-value 3))
         (setq mtext-value (substr mtext-value 3)
           text-value  (strcat text-value " ")
         )
       )
      )
      ((wcmatch (strcase (substr mtext-value 1 2)) "\\S")
       (setq temp-string (substr mtext-value
                     3
                     (- (vl-string-search ";" mtext-value) 2)
                 )
         text-value  (strcat
                   text-value
                   (vl-string-translate
                 "#^\\"
                 "/^\\"
                 temp-string
                   )
                 )
         mtext-value (substr mtext-value (+ 4 (strlen temp-string)))
       )
      )
      (t
       (setq text-value  (strcat text-value (substr mtext-value 1 1))
         mtext-value (substr mtext-value 2)
       )
      )
    )
      )
      text-value
    )

Помогите пожалуйста пофиксить эту ошибку, если можно подскажите пожалуйста что надо изменить? Сложность еще в том что код должен быть совместим с 2000-м автокадом

С уважением.

  • Откуда: Московская обл. / Москва
  • На форуме с 28 сентября 2009г.
  • Сообщений: 3
  • Спасибо: 0

Re: Помогите пожалуйста найти ошибку в коде который убирает форматирование MTEXT

ужос какой...

Ответ от VVA (изменено: Владимир Азарко, 20 ноября 2009г. 09:49:40)

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Помогите пожалуйста найти ошибку в коде который убирает форматирование MTEXT

Artem Vyrtosu, 

(defun mip_MTEXT_Unformat ( Mtext / text Str )
  ;;;https://www.caduser.ru/forum/topic20992.html
  (setq Text "")
  (if (wcmatch (strcase Mtext) "\\PI-#*") ;;_список
    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
       (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 8)) "\\FSYMBOL") ;;;Add VVA remove Symbol
            (setq Mtext (substr Mtext (+ 2 (cond ((vl-string-search "}" Mtext))((vl-string-search ";" Mtext)))))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
      ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PX[QI]")  ;;;Add by KPblC
       (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
       )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
           (zerop (strlen Text))
           (= " " (substr Text (strlen Text)))
           (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
      ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
          
      (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: Помогите пожалуйста найти ошибку в коде который убирает форматирование MTEXT

не все форматирование сносит...
Пример:

"\\pt100;{\\fArial|b0|i0|c204|p34;\\C1;БМО-12-124 Дверь-1шт}"

  • fixo
  • fixo
  • Активный участник
  • Откуда: СПб
  • На форуме с 7 февраля 2009г.
  • Сообщений: 869
  • Спасибо: 41

Re: Помогите пожалуйста найти ошибку в коде который убирает форматирование MTEXT

Попробуй функцию Ли Мака

;;-------------------=={ 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)
    )
    (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))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)


;;Пример вызова: 
(setq newstr (LM:UnFormat (cdr (assoc 1 (entget (car (entsel "\nВыбрать писанину >> "))))) T));<-- Т если MTEXT, nil если ТЕКСТ
(alert  newstr)