Отображение руского текста (mtext) в AutoCad2002 (Страница 1 из 2)

(defun c:clr_all( / selset)
  (setq selset (ssget '((0 . "MTEXT"))))
  (_kpblc-modify-mtext selset)
  )
(defun c:clr_sel( / selset)
  (setq selset (ssget "_X" '((0 . "MTEXT"))))
  (_kpblc-modify-mtext selset)
  )
(defun _kpblc-modify_mtext (selset)
  (while (and
       selset
       (> (sslength selset) 0)
       ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (_kpblc-ent-modify-autoregen
      item
      1
      (_kpblc-clear-mtext (cdr (assoc 1 (entget item))))
      nil
      ) ;_ end of _kpblc-ent-modify-autoregen
    ) ;_ end of while
  ) ;_ end of defun
;|=============================================================================
*    Функция сносит форматирование многострочного текста. Удаляются символы "{"
* и "}", поскольку именно символ "}" является окончанием применения определенного
* фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п.
*    Параметры вызова:
*    string-to-normalize    - строка, которую надо нормализовать
*    Примеры вызова:
(_kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))))
    ; для выбранного многострочного текста очищает форматирование.
=============================================================================|;
(defun _kpblc-clear-mtext    (string-to-normalize             /
             sub_string       sub_pos         left_string
             right_string
             )
  (if (or
    (setq sub_pos (vl-string-search "{f" string-to-normalize))
    (setq sub_pos (vl-string-search "{\\" string-to-normalize))
    (setq sub_pos (vl-string-search "\\f" string-to-normalize))
    (setq sub_pos (vl-string-search "{\\f" string-to-normalize))
    ) ;_ end of or
    (progn
      (setq left_string            ;все, что до "{"
             (substr
               string-to-normalize
               1
               (vl-string-position (ascii "\\") string-to-normalize sub_pos)
               ) ;_ end of substr
        right_string        ;все, что между {f и ;
             (substr
               string-to-normalize
               (+ (vl-string-position (ascii ";") string-to-normalize sub_pos) 2)
               ) ;_ end of substr
        ) ;_ end of setq
      (_kpblc-clear-mtext (strcat left_string right_string))
      ) ;_ end of progn
    (vl-string-trim "}" string-to-normalize)
    ) ;_ end of if
  ) ;_ end of defun
;|=======================================================================================
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*    entity    - примитив, полученный через (entsel), (entlast) etc
*    bit    - dxf-код, значение которого надо установить
*    value    - новое значение
*    regen    - выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)    ; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)    ; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*    примитив с модифицированным dxf-списком. Примитив автоматически перерисовывается.
=======================================================================================|;
(defun _kpblc-ent-modify-autoregen (ent bit value ext_regen / ent_list old_dxf new_dxf)
  (if (not
    (and
      (or
        (= (cdr (assoc 0 (entget ent))) "STYLE")
        (= (cdr (assoc 0 (entget ent))) "DIMSTYLE")
        (= (cdr (assoc 0 (entget ent))) "LAYER")
        ) ;_ end of or
      (= bit 100)
      ) ;_ end of and
    ) ;_ end of not
    (progn
      (setq ent_list (entget ent)
        new_dxf  (cons bit
               (if (and (= bit 62) (= (type value) 'str))
                 (if (= (strcase value) "BYLAYER")
                   256
                   0
                   ) ;_ end of if
                 value
                 ) ;_ end of if
               ) ;_ end of cons
        ) ;_ end of setq
      (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
    (progn
      (entmod (if old_dxf
            (subst new_dxf old_dxf ent_list)
            (append ent_list (list new_dxf))
            ) ;_ end of if
          ) ;_ end of entmod
      (if ent_regen
        (entupd ent)
        (redraw ent)
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ent
  ) ;_ end of defun

(setq entl (entget ent)) ; ent->mtext
(setq ct 0)
  (textpage)
  (repeat (length entl)
    (setq cn (car (nth ct entl)))
    (if  (= cn 3)
      (progn
        (setq cs (cdr (nth ct entl)))
        (print cs)
        [b](clear-mtext cs)[/b]
        (print cs)
        )
       )
    (setq ct (+ ct 1))
  )

(setq string (_kpblc-clear-mtext (vlax-get-property item "textstring")))

    (vlax-put-property
      item
      "textstring"
      string
      ) ;_ end of vlax-put-property

(
(-1 . <Entity name: 7ef899c0>)
(0 . "MTEXT")
(330 . <Entity name: 7ef88e90>)
(5 . "54B0")
(100 . "AcDbEntity")
(67 . 1)
(410 . "секция 9")
(8 . "03.Лист штамп")
(48 . 10.0)
(100 . "AcDbMText")
(10 284.252 42.8368 0.0)
(40 . 2.3)
(41 . 83.5938)
(71 . 1)
(72 . 5)
(1 . "{\\fTimes New Roman|b1|i1|c204|p18;Здесь идет текст, который можно обработать, т.е. потереть times new roman}")
(7 . "Standard")
(210 0.0 0.0 1.0)
(11 1.0 -1.1331e-015 0.0)
(42 . 75.3362)
(43 . 3.03295)
(50 . 6.28319)
(73 . 1)
(44 . 1.0)
)

(
(-1 . <Entity name: 7ef899c8>)
(0 . "MTEXT")
(330 . <Entity name: 7ef88e90>)
(5 . "54B1")
(100 . "AcDbEntity")
(67 . 1)
(410 . "секция 9")
(8 . "03.Лист штамп")
(48 . 10.0)
(100 . "AcDbMText")
(10 283.913 47.0995 0.0)
(40 . 2.3)
(41 . 83.5938)
(71 . 1)
(72 . 5)
(1 . "{\\fTimes New Roman|b1|i1|c204|p18;Многоэтажный жилой комплекс\\fTimes New
Roman|b1|i1|c0|p18; \\fTimes New Roman|b1|i1|c204|p18;по адресу:}")
(7 . "Standard")
(210 0.0 0.0 1.0)
(11 1.0 -1.1331e-015 0.0)
(42 . 67.03)
(43 . 3.03295)
(50 . 6.28319)
(73 . 1)
(44 . 1.0)
)