[sersgey_r]

Уважаемые, подскажите пожалуйста, как в получитьв лисп из Акада атрибуты шрифта, в особенности интересует ширина символа, и ширина между буквами?

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

Читай http://cadhlp.kulichki.com/pdshx.htm , анализируй, пробуй...
Сейчас выяснится, что достаточно применения (textbox)

[sersgey_r]

Сообщение от Кулик Алексей aka kpblc Читай http://cadhlp.kulichki.com/pdshx.htm , анализируй, пробуй... Сейчас выяснится, что достаточно применения (textbox)

Спасибо большое! А вот можете помочь решить эту проблему

Вопрос такой,в коммандной строке такая команда работает (setq ss1 (textbox ss)) и следующая за ней (setq ss2 (car (cadr (ss1)))) а вставляю в ЛИСП и нифига пишет на это (setq ss1 (textbox ss)) nill Подскажите что надо сделать?? (setq s (getstring (strcat "\nКЛЕММА <Выс " (rtos hg)"; Сж " (rtos scal)">:"))) (print s) (setq ss (entget (entlast))) (print ss) (setq ss1 (textbox ss)) (print ss1) (setq ss2 (car (cadr (ss1)))) (print ss2) (setq ss3 10) (setq deltaH (+ (/ hg 2) 1)) (setq deltaLLeft (+ (/ ss3 2) 2.5)) (setq deltaLRight (+ (/ ss3 2) 2.5))

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

Хм... А что, (entlast) обязательно текст?

[sersgey_r]

Сообщение от Кулик Алексей aka kpblc Хм... А что, (entlast) обязательно текст?

данная программа должна напечатать текст в 2.5 мм от линии
вот фрагмент кода расчитыывает координаты блока текста и передает данные для печатания введенного текста
А по поводу обязательно, просто пример в хелпе для textbox дает такую строку с entlast <(setq e (entget (entlast))) >
и если использовать ее в командной строке то работает.
Если есть какой то простой способ, то скажите, буду очень РАД!

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

Спробуй, я особо не тестировал:

Код:

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

(defun _kpblc-get-textbox (string lst / style height rot width obliq base)
                          ;|
*    Функция-аналог textbox'a. Возвращает координаты однострочного (!) текста
* в текущей системе координат.
*    Параметры вызова:
*	string	строка, для которой надо получить textbox
*	lst	список дополнительных параметров:
      '(("style" . <Имя стиля текста>)	; nil либо отсутствующий - используется текущий
	("base" . <Базовая точка, от которой вычислять координаты>) ; nil -> 0. 0. 0.
	("height" . <Высота текста>)	; nil -> берется из style либо, если в
		; style высота = 0, (getvar "textsize")
	("rotate" . <Угол поворота, радиан>)	; nil -> 0.
	("width" . <Коэффициент сужения>)	; nil -> 1.
	("angle" . <Угол наклона от вертикали>)	; nil -> 0.
	)
|;
  (if (or (not (cdr (assoc "style" lst)))
          (not (tblobjname "style" (cdr (assoc "style" lst))))
          ) ;_ end of or
    (setq style (getvar "textstyle"))
    (setq style (cdr (assoc "style" lst)))
    ) ;_ end of if
  (setq height (cond
                 ((and (cdr (assoc "height" lst))
                       (>= (cdr (assoc "height" lst)))
                       ) ;_ end of and
                  (cdr (assoc "height" lst))
                  )
                 ((/= 0. (cdr (assoc 40 (entget (tblobjname "style" style)))))
                  (cdr (assoc 40 (entget (tblobjname "style" style))))
                  )
                 (t (getvar "textsize"))
                 ) ;_ end of cond
        rot    (cond ((cdr (assoc "rotate" lst)))
                     (t 0.)
                     ) ;_ end of cond
        width  (cond ((cdr (assoc "width" lst)))
                     (t 1.)
                     ) ;_ end of cond
        obliq  (cond ((cdr (assoc "angle" lst)))
                     (t 0.)
                     ) ;_ end of cond
        base   (cond ((cdr (assoc "base" lst)))
                     (t '(0. 0. 0.))
                     ) ;_ end of cond
        ) ;_ end of setq
  (mapcar '(lambda (x)
             (polar base rot (distance x base))
             ) ;_ end of LAMBDA
          (textbox (list (cons 0 "TEXT")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbText")
                         (cons 10 base)
                         (cons 40 height)
                         (cons 1 string)
                         (cons 50 0.)
                         (cons 41 width)
                         (cons 51 obliq)
                         (cons 7 style)
                         ) ;_ end of list
                   ) ;_ end of textbox
          ) ;_ end of mapcar
  ) ;_ end of defun

[sersgey_r]

спасибо, тестирую
а подскажи как после вывода строки ее удалить как графический объект???
чтобы от нее ничего не осталось???

(setq sp (list 10.0 10.0)) (setq ss3 s) ; здесь s - введенная строка (command "TEXT" "_J" "_M" sp 3.0 0 ss3)

Заранее спасибо )

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

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

Код:

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

  (setq command_executing_result ; сюда засовываем результат выполнения команды
         (if
           (= (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle"))))) 0.)
            (vl-cmdf "_.text" "_j" "_m" base_point 3.0 0.0 string)
            (vl-cmdf "_.text" "_j" "_m" base_point 0. string)
            ) ;_ end of if
        ) ;_ end of setq
  (if command_executing_result ; если t, то есть объект был создан
    (progn
      (entdel (entlast))
      (princ
        "\nОбъект однострочного текста был успешно создан и впоследствии удален"
        ) ;_ end of princ
      ) ;_ end of progn
    (princ "\n*** Ошибка! Объект невозможно создать!")
    ) ;_ end of if