Редактирование коэффициента сжатия

Shoorup · 22.07.2008, 11:07

Задача такая:
Есть куча чертежей (как обычно

) в которых куча однострочных текстов содержащих от 6 до 12 символов. Выравнивание у них всегда либо "влево" либо "вправо". Коэффициент сжатия всегда при изменениях варьируется. Но стандартно он не превышает 0.8 В зависимости от того как расположена близ лежащая линия изменяется коэффициент сжатия (вручную - что утомительно методом подбора). Изменяется он ступенчато до двух знаков после запятой. (0.8; 0.79; 0.78 ... 0.45)
Необходимо написать програмку которая будет это делать автоматически.
Т.е. например у меня есть горизонтальная линия справа от нее написан текст который либо слишком сжат либо переваливает через линию. Выбираем линию и потом тексты. При выборе очередного текста он автоматом изменяет коэффициент сжатия на необходимый.

Shoorup · 22.07.2008, 11:15

Дополнение:
хотелосьбы еще добавить к этой программе возможность править в прямоугольнике текст который также либо сжат либо выходит за пределы. Выравнивание может быть либо по левому краю либо по правому либо по середине.

Совсем забыл, расстояние от текста до линии должно быть 1 ... 1.5мм (хорошо бы это можно былобы править)

Aragorn · 22.07.2008, 11:51

Shoorup · 22.07.2008, 12:06

Aragorn, ?

Donhuan · 22.07.2008, 22:24

Если хочешь написать программу самостоятельно (прочитал в соседнем посте, что желание такое у тебя есть), то подсказываю примерный алгоритм действий:
1) Выбираешь какую-либо из колонок текстов:

Код:

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

(vl-remove-if 'listp (mapcar (function cadr) (ssnamex (ssget '((0 . "TEXT")))))); возвращает список имен объектов-тект (ename)

2) Таким же образом выбираешь полилинию, которая должна ограничивать текст, правда в твоем случае лучше указать ее при помощи ввода двух точек - не придется вычислять координаты нужного отрезка.
Затем для каждого из текстов:
3) Вычисляешь нужные точечные пары: 41 - сжатие, 11 - координаты точки выравнивания (если текст выровнен вправо).

Код:

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

(cdr (assoc 41(entget имя_из_полученного_ранее_списка)))

4) При помощи функции "textbox" вычисляешь координаты рамки которая описывается вокруг текста. Далее из этих координат можно вычислить длину текста.
5) Вычисляешь расстояние мечду точкой выравнивания и линией - это длина текста, которая должна быть.
6) Вычисляешь коэффициент сжатия, который должен быть для достижения нужной длины текста и модифицирешь объект.
7) Переходишь к следующему объекту,если нет объектов,то выход.

Shoorup · 23.07.2008, 09:26

Donhuan, спасибо. Попробую сам написать.
Сразу вопрос:
Допустим секущей рамкой я выбираю кучу ненужных объектов как мне отделить только текст? Чтобы выбрался только текст. Наверно придется доработать потому как выбирать текст без "тире" не нужно. Короче заморочек много ...
Работать программа должна так: (ну как я хотел бы)
1. Выбирать нужно допустим лист целый на котором присутствует любые объекты. Программа должна выбирать именно то что нужно и формировать список нужных текстов. При этом выравнивание как я написал в первом посте может быть только двух типов.
2. При нажатии Enter должен изменятся выбранный текст в нужном соответствии.

Для начала нужно разобраться с первым пунктом. Правильно ли я мыслю, что должен формироваться именно список нужных объектов? или этот процесс выглядит как-то подругому? Какие функции мне нужны для выполнения первого пункта?

Кулик Алексей aka kpblc · 23.07.2008, 09:45

Код:

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

(ssget '((0 . "TEXT") (1 . "*-*"))) ; выбор текстов, где есть "-"
(ssget '((0 . "TEXT") (1 . "~*-*"))); выбор текстов без "-"

P.S. Смотри wcmatch

Shoorup · 23.07.2008, 15:43

Кулик Алексей aka kpblc, не могу понять со списками
(ssget '((0 . "TEXT"))) - почему так правильно
(ssget '(0 . "TEXT")) - а так нет?

Кулик Алексей aka kpblc · 23.07.2008, 16:04

Потому что первый можно перевести как

Код:

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

(ssget (list (cons 0 "TEXT")))

(ssget) принимает только списки из точечных пар, а у тебя во втором варианте просто точечная пара (это недостаточно).

Shoorup · 23.07.2008, 16:55

Всеравно ступор со списками

(cons 0 "TEXT") - функция cons создаст точечную пару (0 . "TEXT") .
(list (cons 0 "TEXT")) - а такое вызовет ошибку
зато вот такое:
(list '(cons 0 "TEXT")) - почемуто правильно
Вопрос:
почему тогда правильно это:
(ssget (list (cons 0 "TEXT")))

Кулик Алексей aka kpblc · 23.07.2008, 19:26

Shoorup, сравни:

Код:

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

_$ (cons 0 "TEXT")
(0 . "TEXT")
_$ (list (cons 0 "TEXT"))
((0 . "TEXT"))
_$ (list '(cons 0 "TEXT"))
((CONS 0 "TEXT"))
_$

Разница есть?

Shoorup · 24.07.2008, 09:25

Есть...
в первом случае создается точечная пара, во втором список с точечной парой, в третьем список из списка. Так?

Shoorup · 24.07.2008, 10:10

По задаче:
Как предложил Donhuan, во втором пункте #5 мне на первом этапе лучше попробовать указать две точки по которым нужно ровнять. Или что более универсально но мне кажется сложней, выбрать один или несколько прямоугольников в виде полилиний на чертеже которые и есть сама клемма и отступить от нее 1 мм. Получается коэффициент сжатия нужно расчитать так: Берем расстояние от полилинииклеммы отступаем 1 мм вправо и влево от нее. Расчитываем расстояние от точки вставки текста до полученной линии. Устанавливаем коэффициент сжатия чтобы текст не заходил за эту линию и максимально к ней приближался но не превышал КЖ 0.8

VVA · 24.07.2008, 10:20

Shoorup,
Теперь прорабатываешь главу 2 "Основы язка LISP" .
И должны отпасть вопросы про:
- QUOTE,
- атомы, списки,
- голову списка (head) и его хвост (tail)
- логические значения ИСТИНА и ЛОЖЬ
- пустой список
+ выполнить все упражнения в vlide

Shoorup · 28.07.2008, 16:34

какая функция внесет изменения в точечную пару?

Кулик Алексей aka kpblc · 28.07.2008, 16:55

это как? (cons <Значение> <Значение>), что ли?

Shoorup · 28.07.2008, 17:06

Ну допустим я выделил нужный мне текст и хочу внести в его свойства определенные изменения. Получается мне нужно "раскрыть его" и внести в соответствующие точечные пары изменения. Допустим был текст с КС 0.8 - после применения стал 07

Кулик Алексей aka kpblc · 28.07.2008, 17:08

Модификация ename-представлений примитивов

Shoorup · 28.07.2008, 17:24

Мне там ничего не понятно. Слишком сложно для моего уровня. Может подскажешь как для чайника что делать?

Donhuan · 28.07.2008, 20:52

Цитата:

Сообщение от Shoorup

Мне там ничего не понятно. Слишком сложно для моего уровня. Может подскажешь как для чайника что делать?

Просто добавь в свою программу эти функции и используй их, как используешь функции Лиспа.
А по поводу изменений точечных пар почитай про функии "assoc" и "subst". Просто в указанной теме все уже сделали, упростив тебе задачу.

Shoorup · 28.07.2008, 22:52

Donhuan, спасибо. Буду штудировать.

Кулик Алексей aka kpblc · 28.07.2008, 23:51

Учиться мне сейчас что-то лениво, поэтому один из вариантов кода:

Код:

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

(defun test (adds              /                 fun_get-length-by-angle
             text              plines            adoc
             *error*           _dwgru-conv-pickset-to-list
             min_dist          text_box          err
             )

            ;|
*    adds -> "ширина" дополнительных пропусков спереди и сзади текста.
*    Проверок минимум
*    Пример вызова:
(test 0.)
(test 1.5)
*    Точка вставки и выравнивание текста не меняется и не анализируется.
|;

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun fun_get-length-by-angle (ent ang / coord res counter)
    (setq ent     (entget ent)
          coord   (mapcar 'cdr
                          (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
                          ) ;_ end of mapcar
          ang     (cos ang)
          counter 0
          ) ;_ end of setq
    (if (= (logand (cdr (assoc 70 ent)) 1) 1)
      (setq coord (append coord (list (car coord))))
      ) ;_ end of if
    (repeat (1- (length coord))
      (if (or (equal (cos (angle (nth counter coord) (nth (1+ counter) coord)))
                     ang
                     1e-6
                     ) ;_ end of equal
              (equal (cos (angle (nth (1+ counter) coord) (nth counter coord)))
                     ang
                     1e-6
                     ) ;_ end of equal
              ) ;_ end of or
        (setq
          res
           (cons (distance (nth counter coord) (nth (1+ counter) coord)) res)
          ) ;_ end of setq
        ) ;_ end of if
      (setq counter (1+ counter))
      ) ;_ end of repeat
    (reverse res)
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (and (setq text ((lambda ()
                         (prompt "\nВыбирай тексты : ")
                         (ssget "_:L" '((0 . "*TEXT")))
                         ) ;_ end of lambda
                       )
                 ) ;_ end of setq
           (setq plines
                  (cond
                    (((lambda ()
                        (prompt "\nВыбери как минимум одну полилинию : ")
                        (ssget '((0 . "LWPOLYLINE")))
                        ) ;_ end of lambda
                      )
                     )
                    (t
                     (getdist
                       (strcat
                         "\nУкажи расстояние, в которое надо вписывать, включая отступ в "
                         (rtos adds)
                         " ед. : "
                         ) ;_ end of strcat
                       ) ;_ end of getdist
                     )
                    ) ;_ end of cond
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (setq min_dist
             (cond
               ((= (type plines) 'pickset)
                (- (apply 'min
                          (apply 'append
                                 (mapcar '(lambda (x) (fun_get-length-by-angle x 0.))
                                         (_dwgru-conv-pickset-to-list plines)
                                         ) ;_ end of mapcar
                                 ) ;_ end of apply
                          ) ;_ end of apply
                   adds
                   ) ;_ end of -
                )
               (t (- plines adds))
               ) ;_ end of cond
            ) ;_ end of setq
      (foreach item (_dwgru-conv-pickset-to-list text)
        (if (vl-catch-all-error-p
              (setq err
                     (vl-catch-all-apply
                       (function
                         (lambda (/ real_dist)
                           (vla-put-scalefactor (vlax-ename->vla-object item) 1.)
                           (if
                             (>= (setq
                                   real_dist
                                    (abs (apply
                                           '-
                                           (mapcar 'car (textbox (entget item)))
                                           ) ;_ end of apply
                                         ) ;_ end of abs
                                   ) ;_ end of setq
                                 min_dist
                                 ) ;_ end of >=
                              (vla-put-scalefactor
                                (vlax-ename->vla-object item)
                                (/ min_dist real_dist)
                                ) ;_ end of vla-put-scalefactor
                              ) ;_ end of if
                           ) ;_ end of lambda
                         ) ;_ end of function
                       ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of vl-catch-all-error-p
          (princ (strcat "\n** error ** : " (vl-catch-all-error-message err)))
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Shoorup · 29.07.2008, 09:24

Кулик Алексей aka kpblc, чтото не очень понятно что эта прога делает

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

Кулик Алексей aka kpblc · 29.07.2008, 09:39

Я гонял на твоем файле. Видео, как я вызывал - в аттаче

Shoorup · 29.07.2008, 11:03

Получилось! Супер! Спасбо Алексей огромное.

Shoorup · 29.07.2008, 11:09

Алексей, если не сложно добавь еще чтобы можно было текст ровнять не только по полилинии, но и по просто линии.

Кулик Алексей aka kpblc · 29.07.2008, 11:16

В коде найди строку

Код:

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

(ssget '((0 . "LWPOLYLINE")))

и замени на

Код:

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

(ssget '((0 . "LINE,LWPOLYLINE")))

У меня сейчас просто шансов нуль исправить по полной. По идее работать должно
P.S. Кстати, если не укажешь никакой примитив, то можно будет просто указывать расстояние

Попробуй, может, такой вариант окажется более удобным?
P.P.S. Если указывать несколько примитивов, то будет выбираться минимальная длина горизонтального участка.
---
Добавлено: только что "дошло". Работать не будет предложенное исправление. Придется погодить

Кулик Алексей aka kpblc · 30.07.2008, 01:21

Как вариант - см.аттач.

Shoorup · 30.07.2008, 11:03

(compress-text 0.)
(compress-text 1.5)
Не могу догнать как работает это? Что означает сие цыфры? Да и вообще принцип работы программы не очень понимаю. Алексей если не сложно объясни.

Кулик Алексей aka kpblc · 30.07.2008, 11:35

Ну а что там объяснять? Если, например, текст вписывается в прямоугольник с координатами по оси Х 10 - 50 (то есть "длина" текста 40), а отрезок имеет длину по той же оси 16, то тексту назначается коэффициент сжатия (при compress-text 1.5):

Там просто аналитики многовато (возможно, лишней)

allar8 · Регистрация: 12.03.2013

У меня АСАД 2010. Есть блоки с многострочными атрибутами. Для них почему то не активно редактирование коэффициента растяжения
(редактор атрибутов блоков -> Параметры текста -> Степень растяжения - Не активна). Можно как нибудь решить эту проблему?

Do$ · 09.08.2013, 15:26

Может быть это от шрифта зависит? С этим шрифтом обычный мультитекст сжимается?

Олег (jr.) · 10.08.2013, 13:19

Цитата:

Сообщение от allar8

У меня АСАД 2010. Есть блоки с многострочными атрибутами. Для них почему то не активно редактирование коэффициента растяжения
(редактор атрибутов блоков -> Параметры текста -> Степень растяжения - Не активна). Можно как нибудь решить эту проблему?

Попробуй так

Код:

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

(defun C:demo(/ attObj en scl)
  (vl-load-com)
(if
(and(setq en (nentsel "\nSelect Attribute: "))
    (setq scl (getreal "\nScale Factor: ")))
(progn
(setq attObj (vlax-ename->vla-object(car en)))
(if ;|check if selected is multiline attribute|;
  (eq :vlax-true (vla-get-mtextattribute attObj))
  (progn
  (vla-put-mtextboundarywidth attObj scl)
  (vla-put-scalefactor attObj scl)
  
;;;possible values are: 
;;;acLeftToRight - 1 	
;;;acRightToLeft - 2 	
;;;acTopToBottom - 3	
;;;acBottomToTop - 4 	
;;;acByStyle - 5	
  
  (vla-put-mtextdrawingdirection attObj
    (vla-get-mtextdrawingdirection attObj));<-- would not work in ObjectDBX application  ! 
  (vla-updatemtextattribute attobj))
  (progn ;|single text attribute|;
    (vla-put-scalefactor attObj scl)
    (vla-update attobj)
    )
  )
)
)(princ))

Эдуард · 15.08.2013, 12:39

Вы пытаетесь заново написать команду Textfit ?

Олег (jr.) · 15.08.2013, 14:42

Цитата:

Сообщение от Эдуард

Вы пытаетесь заново написать команду Textfit ?

Ба, кого я вижу, ES, большой привет!
Это мне ?

Эдуард · 15.08.2013, 15:18

Привет. Я написал всем участникам темы. Автору нужно (имхо) уйти от подбора вручную коэффициента сжатия текста , что успешно и выполняет команда Textfit.

Олег (jr.) · 15.08.2013, 18:18

@Эдуард,
Рад что ты снова в строю,
Удачи и успехов,
Many regards

allar8 · 12.09.2013, 11:29

Цитата:

Сообщение от allar8

У меня АСАД 2010. Есть блоки с многострочными атрибутами. Для них почему то не активно редактирование коэффициента растяжения
(редактор атрибутов блоков -> Параметры текста -> Степень растяжения - Не активна). Можно как нибудь решить эту проблему?

Я нашел ответ. Системная переменная ATTIPE

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Редактирование однострочного текста на чертеже	Nick Fur	AutoCAD	12	10.03.2012 08:10
Редактирование размеров	Piton	AutoCAD	12	10.02.2010 23:06
при выборе команды редактирование текста вырубается Acad	Nikolays	AutoCAD	4	24.10.2007 09:14
Редактирование атрибутов/внешней ссылки.	Alan	AutoCAD	2	09.03.2006 17:09