[leshkabar]

Пользуюсь таким кодом для быстрого изменения высоты текста.

Код:

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

 (defun c:th (/ sset i txtheight textsize)
  (vl-load-com)
  (setq i 0)
  (setq sset (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
  (if sset
    (progn
      (setq textsize (getvar "textsize"))
      (setq txtheight (getdist (strcat "\nSpecify text height <" (rtos textsize) ">: ")))
      (if (= txtheight nil) (setq txtheight textsize))
      (repeat (sslength sset)
        (vla-put-height (vlax-ename->vla-object (ssname sset i)) txtheight)
        (setq i (1+ i))
      )
      (setq sset nil)
    )
  )
  (princ)
)

(princ "\nRun with the TH command")
(princ)

)

Вынес необходимые кнопки с высотами на панель и быстро меняю TEXT и MTEXT в проекте при необходимости. Однако, есть проблемка.
Код не работает с :
- Мультивыносками
- СПДСными Позиционными выносками
- СПДСными Выносками для многослойных конструкций.
- высотой текста в ячейке в таблицах

.. Может кто-нибудь сделать апгрейд?

.

[Сергей812]

это не апгрейд, а новая программа по сути) И, кстати, в фильтре ssget можно одним условием и текст, и мультитекст выбирать - "*TEXT".

[Sege]

vla-put-height не работает с мультитекстом, а высоту для таблицы меняет высоту самой таблицы

[Сергей812]

и почему текстовыми стилями не воспользоваться...

[name02]

Вот такой "апгрейд":

Код:

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

 (defun c:th (/ sset txtheight textsize i obj obj_name row column)
  (vl-load-com)

  (setq sset (ssget '((0 . "*TEXT,MULTILEADER,ACAD_TABLE"))))
  (if sset
    (progn
      (setq textsize (getvar "textsize"))
      (setq txtheight (getdist (strcat "\nSpecify text height <" (rtos textsize) ">: ")) ;_ end getdist
      ) ;_ end setq
      (if (= txtheight nil)
        (setq txtheight textsize)
      ) ;_ end if
      (setq i 0)
      (repeat (sslength sset)
        (setq obj (vlax-ename->vla-object (ssname sset i)))
        (setq obj_name (vlax-get-property obj 'ObjectName))
        (cond
          ((wcmatch obj_name "AcDbMLeader") (vla-put-TextHeight obj txtheight))
          ((wcmatch obj_name "*Text") (vlax-put-property obj 'Height txtheight))
          ((wcmatch obj_name "AcDbTable")
           (vla-put-RegenerateTableSuppressed obj :vlax-true)
           (setq
             row 0
             column 0
           ) ;_ end setq
           (repeat (vla-get-rows obj)
             (repeat (vla-get-columns obj)
               (vla-SetCellTextheight obj row column txtheight)
               (setq column (1+ column))
             ) ;_ end repeat
             (setq
               column 0
               row    (1+ row)
             ) ;_ end setq
           ) ;_ end repeat
           (vla-RecomputeTableBlock obj :vlax-true)
           (vla-put-RegenerateTableSuppressed obj :vlax-false)
          ) ;_ end cond
        ) ;_ end cond
        (setq i (1+ i))
      ) ;_ end repeat
    ) ;_ end progn
  ) ;_ end if
  (princ)
) ;_ end defun

Что касается СПДС-ных объектов - наверное у них свои есть методы и свойства, но надо разбираться

[Ingpro]

Сообщение от name02 Вот такой "апгрейд":

Отличный апгрейд!!!

[Кулик Алексей aka kpblc]

(wcmatch obj_name "AcDbMLeader") (vla-put-TextHeight obj txtheight)
влегкую может вывалить ошибку, если у мультивыноски тип аннотации не текст

[leshkabar]

Сообщение от name02 Вот такой "апгрейд":

name02!, спасибо тебе огромное добрый человек. Просто бомба! То что нужно. Всё работает. Мало того!, как ни странно, код у меня срабатывает даже с СПДСными выносками, всё меняется как нужно, даже высоту текста в Таблицах меняет! Супер.
... единственное, маленькая просьба - Можешь сделать чтобы шрифт менялся в таблице не во всех ячейках, а только в выбранной?
Ещё раз СПАСИБО.