[Тим Боль]

Здравствуйте, подскажите, пожалуйста, как можно определить ширину объекта TEXT.

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

(textbox) либо (vla-getboundingbox)
В первый передается, по-моему, либо ename-указатель на объект текста, либо список, достаточный для создания объекта через (entmake). Во второй передается vla-указатель на существующий объект.

[Pilot]

Пример функции для определения длины литерала t1 для текущего текстового стиля:

Код:

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

(defun TxtLen (t1)
(caadr (textbox (list (cons 1 t1))))
);end TxtLen

[Тим Боль]

Спасибо!

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

Pilot, все же лучше передавать полный список. При высоте текущего текстового стиля = 0 можно иногда получить странные результаты
То есть я бы передавал нечто типа:

Код:

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

(textbox
  '((0 . "TEXT")
    (100 . "AcDbEntity")
    (100 . "AcDbText")
    (10 0. 0. 0.)
    (40 . 2.5)
    (1 . "Запрашиваемый текст")
    (50 . 0.0)
    (41 . 1.0)
    (51 . 0.0)
    (7 . "Standard")
    (71 . 0)
    (72 . 0)
    (11 0.0 0.0 0.0)
    (210 0.0 0.0 1.0)
    (100 . "AcDbText")
    (73 . 0)
    )
  ) ;_ end of textbox

В таком случае просто гарантировано корректное получение значений точек.

[ShaggyDoc]

Как показал Pilot делать нельзя - будут ошибки при изменении высоты и наклона. Лучше оформить функцией

Код:

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

 
(defun ru-string-length (s txt_height / lsttxt)
;;; длина строки s в единицах рисунка 
;;; при текущей высоте текста txt_height
  (if (and s (/= s ""))
    (progn
      (setq lsttxt (textbox (list (cons 1 s) (cons 40 txt_height) (cons 50 0)))) 
      (- (caadr lsttxt) (caar lsttxt))
    ) 
    0.0
   ) 
)

Текущая (или любая другая) высота текста передается аргументом. Вычисляется во внешней функции.

[Pilot]

Я показал функцию, которую использую сам в своих программах для достаточно локальных целей.
Ошибок в работе функции внутри этих программ мной не замечено.
Точность результата меня вполне устраивает даже при наклонном тексте (преимущественно для определения длины полки выноски или размера прямоугольника вокруг текста, а при этом все равно делается некоторый запас).
Но изначально есть некоторые ограничения:
- Текущий стиль только с высотой текста 0.
- Текущая высота текста не 0.
- есть еще что-то, сразу не вспомнить.

[PiP]

Здравствуйте! А есть ли в VBA функция, подсчитывающая реальную ширину текста ( и высоту MText) ? Не нашел в HELP :-(
В PASCAL, помнится, было что-то вроде TextWidth и TextHeight для "ширины" и "высоты" строки...

[kp+]

Кажется, нет.
Если нужна реальная, чисто конкретно, высота и ширина текста, без поправок на разные углы наклона и проч., как если в натуре померять линейкой, то наверно, можно сделать так:
- "взорвать" текст до уровня линейных примитивов (должно получиться что-то вроде результата работы команды txtexp);
- по этим объектам вычислить высоту и ширину текста;
- удалить этот мусор.

Но это так, в порядке бесплатного совета. Реализация наверняка будет громоздкой и глючной. Может, есть что-то лучше

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

PiP, kp+, почитайте тему с самого начала...

[PiP]

Прошу прощения, задержался с ответом - были проблемы с железом (компьютерным).
Не врубился - какой пост я пропустил? Про VBA, вроде, еще не было ничего...

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

GetBoundingBox

[PiP]

В этом и проблема: GetBoundingBox дает цифры, указанные в entity.Width и entity.Height (про последнее- не проверял). И возвращает мне ... ну очень много, а текст - всего 2 буквы. Так как файл dwg прислан от смежников - распросить и понять зачем такое сделано - затруднено. Просто образать (типа entity.Width = 4) - рука не поднимается.

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

Тогда образец нужон.

[PiP]

Сообщение от Кулик Алексей aka kpblc Тогда образец нужон.

Primer_MText.bas
primer_MText.dwg
- в архиве primerMT.rar

Для entity.Height - тоже справедливо, увы...

[VVA]

Почитай еще здесь
Автоматический подбор высоты текста
Там, правда, рассматривалисть acet-* ф-ции. Но к ним можно обратиться из VBA через SendComand, зная метку (dxf код 5) примитива
Что-то типа

Код:

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

 
    ThisDrawing.SendCommand _
    ("(setvar & Chr(34) & USERR1 & Chr(34) _
      " (ACET-GEOM-TEXTBOX (handent METKA)))" & vbCr)

И прочитать значение переменной USERR1

[PiP]

Спасибо. К сожалению - (лисп (придется) (учить (тоже)))...