Тема: LISP. Выравнивание текстов по горизонтали или вертикали

О недостатках:
Пока не выравнивает многострочные тексты.

;| ********************************************
* Выравнивание текстовых(однострочных) объектов
* по осям относительно указанной точки
*
* Copyright ?2005
*           Виталий Зуенко (ZZZ)
*
***********************************************|;
;;;Запуск с командной строки
(defun c:z-text-align (/ ss-pt align_axes align_side_x align_side_y)
  (if (not zv_ta)
    (setq zv_ta    (list (cons "align_axes" "X")
              (cons "align_side_x" "Left")
              (cons "align_side_y" "Bottom")
              ) ;_ list
      ) ;_ setq
    ) ;_ if
  (if (setq ss-pt (z-text-align-input-ss-pt))
    (progn
      (initget "X Y")
      (setq align_axes
         (getkword (strcat "Выровнять по осям [X/Y]<"
                   (cdr (assoc "align_axes" zv_ta))
                   ">"
                   ) ;_ strcat
               ) ;_ getkword
        ) ;_ setq
      (if (not align_axes)
    (setq align_axes (cdr (assoc "align_axes" zv_ta)))
    ) ;_ if
      (if (= align_axes "X")
    (progn
      (initget "Left Center Right")
      (setq    align_side_x
         (getkword (strcat "Выровнять  [Left/Center/Right]<"
                   (cdr (assoc "align_side_x" zv_ta))
                   ">"
                   ) ;_ strcat
               ) ;_ getkword
        ) ;_ setq
      ) ;_ progn
    (progn
      (initget "Top Center Bottom")
      (setq    align_side_y
         (getkword (strcat "Выровнять  [Top/Center/Bottom]<"
                   (cdr (assoc "align_side_y" zv_ta))
                   ">"
                   ) ;_ strcat
               ) ;_ getkword
        ) ;_ setq
      ) ;_ progn
    ) ;_ if
      (if (not align_side_x)
    (setq align_side_x (cdr (assoc "align_side_x" zv_ta)))
    ) ;_ if
      (if (not align_side_y)
    (setq align_side_y (cdr (assoc "align_side_y" zv_ta)))
    ) ;_ if
      (setq zv_ta (list    (cons "align_axes" align_axes)
            (cons "align_side_x" align_side_x)
            (cons "align_side_y" align_side_y)
            ) ;_ list
        ) ;_ setq
      (z-text-align
    (car ss-pt)
    (cadr ss-pt)
    align_axes
    (if (= align_axes "X")
      align_side_x
      align_side_y
      ) ;_ if
    ) ;_ z-text-align
      ) ;_ progn
    ) ;_ if
  (princ)
  ) ;_ defun
;;;Выбор объектов и указание точки выравнивания
(defun z-text-align-input-ss-pt    (/ ss pt_align)
  (setq ss (ssget (list'(0 . "TEXT"))))
  (if (and ss (> (sslength ss) 0))
    (if    (setq pt_align (getpoint "\nВведите точку выравнивания: "))
      (list ss pt_align)
      ) ;_ if
    ) ;_ if
  ) ;_ defun
;;;Исполнительная функция выравнивания текста
(defun z-text-align (ss pt_align align_axes align_side / ent pt_text)
  (vla-StartUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
  (setvar "cmdecho" 0)
  (if (or (not ss) (not pt_align))
    (setq ss-pt (z-text-align-input-ss-pt))
    ) ;_ if
  (if ss-pt
    (progn
      (setq ss (car ss-pt))
      (setq pt_align (cadr ss-pt))
      (foreach ent (vl-remove-if
             '(lambda (a) (listp a))
             (mapcar 'cadr (ssnamex ss))
             ) ;_ vl-remove-if
    (setq pt_text (assoc 10 (entget ent)))
    (z-ent-mod-lst
      ent
      (cond    ((or (= align_side "Left") (= align_side "Bottom"))
         '((72 . 0) (73 . 0) (11 0.0 0.0 0.0))
         )
        ((= align_side "Center")
         '((72 . 1) (73 . 0) (11 0.0 0.0 0.0))
         )
        ((or (= align_side "Right") (= align_side "Top"))
         '((72 . 2) (73 . 0) (11 0.0 0.0 0.0))
         )
        ) ;_ cond
      ) ;_ z-ent-mod-lst
    (cond
      ((= align_axes "X")
       (if (= align_side "Left")
         (z-ent-mod ent 10 (list (car pt_align) (caddr pt_text) 0))
         (z-ent-mod ent 11 (list (car pt_align) (caddr pt_text) 0))
         ) ;_ if
       )
      ((= align_axes "Y")
       (if (= align_side "Bottom")
         (z-ent-mod ent 10 (list (cadr pt_text) (cadr pt_align) 0))
         (z-ent-mod ent 11 (list (cadr pt_text) (cadr pt_align) 0))
         ) ;_ if
       )
      ) ;_ cond
    ) ;_ foreach
      ) ;_ progn
    ) ;_ if
  (vla-EndUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
  (setvar "cmdecho" 1)
  (princ)
  ) ;_ defun
;;;*Вспомогательные функции*
;;;Задание свойства объекта
;;;(z-ent-mod (ssname (ssget '((0 . "TEXT"))) 0) 1 "AAAA")
(defun z-ent-mod (ename bit value / ent_list old_dxf new_dxf)
  (setq ent_list (entget ename))
  (setq new_dxf (cons bit value))
  (if (/= 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))
        ) ;_ if
          ) ;_ entmod
      (entupd ename)
      ) ;_ progn
    ) ;_ if
  ename
  ) ;_ defun
;;;_Задание свойств объекта списком свойств
;|(z-ent-mod-lst
    (ssname (ssget '((0 . "TEXT"))) 0)
    '((1 . "AAAA") (62 . 1))
    ) ;_ z-ent-mod-lst
|;
(defun z-ent-mod-lst (ename lst_data / raw_data)
  (setq raw_data (entget ename))
  (mapcar '(lambda (a)
         (setq raw_data (if    (assoc (car a) raw_data)
                  (subst a (assoc (car a) raw_data) raw_data)
                  (append raw_data (list a))
                  ) ;_ if
           ) ;_ setq
         ) ;_ lambda
      lst_data
      ) ;_ mapcar
  (entmod raw_data)
  (entupd ename)
  ) ;_ defun

Примеры вызова:
в командной строке z-text-align
Из меню или на кнопках:

^C^C_z-text-align
^C^C^P(z-text-align nil nil "X" "Left")
^C^C^P(z-text-align nil nil "X" "Center")
^C^C^P(z-text-align nil nil "X" "Right")
^C^C^P(z-text-align nil nil "Y" "Top")
^C^C^P(z-text-align nil nil "Y" "Center")
^C^C^P(z-text-align nil nil "Y" "Bottom")

Р.S. Лично я не пользуюсь вызовом данной команды в командной строке, удобнее кликать по кнопочкам типа выпадающего тоолбара (Flyout).

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Улучшеная версия программы
Изменение:
Указания стороны выравнивания только лево/центр/право. лево/центр/право - подразумевается сторона текста. Если текст вертикально расположен, то низ считается левой стороной.
Добавленно:
1.Выравнивание многострочного текста
2.Отфильтровка объектов заблокированных слоёв

;| ********************************************
* Выравнивание текстовых объектов
* по вертикали или горизонтали
* относительно указанной точки
*
* Copyright ?2005
*           Виталий Зуенко (ZZZ)
*
***********************************************|;
;|Запуск с командной строки:
z-text-align
из меню или на кнопке:
^C^C^P_z-text-align
c VisulLisp:
(c:z-text-align)
|;
(defun c:z-text-align (/ ss-pt align_axes align_side_x align_side_y)
  (if (not zv_ta)
    (setq zv_ta    (list (cons "align_axes" "X")
              (cons "align_side" "Left")
              ) ;_ list
      ) ;_ setq
    ) ;_ if
  (if (setq ss-pt (z-text-align-input-ss-pt))
    (progn
      (initget "X Y")
      (setq align_axes
         (getkword (strcat "Выровнять по осям [X/Y]<"
                   (cdr (assoc "align_axes" zv_ta))
                   ">"
                   ) ;_ strcat
               ) ;_ getkword
        ) ;_ setq
      (if (not align_axes)
    (setq align_axes (cdr (assoc "align_axes" zv_ta)))
    ) ;_ if
      (initget "Left Center Right")
      (setq align_side
         (getkword (strcat "Выровнять  [Left/Center/Right]<"
                   (cdr (assoc "align_side" zv_ta))
                   ">"
                   ) ;_ strcat
               ) ;_ getkword
        ) ;_ setq
      (if (not align_side)
    (setq align_side (cdr (assoc "align_side" zv_ta)))
    ) ;_ if
      (setq zv_ta (list    (cons "align_axes" align_axes)
            (cons "align_side" align_side)
            ) ;_ list
        ) ;_ setq
      (z-text-align
    (car ss-pt)
    (cadr ss-pt)
    align_axes
    align_side
    ) ;_ z-text-align
      ) ;_ progn
    ) ;_ if
  (princ)
  ) ;_ defun
;;;(z-text-align-input-ss-pt)
;;;Выбор объектов и указание точки выравнивания
(defun z-text-align-input-ss-pt  (/ ss pt_align)
  (setq    ss (ssget (list    '(0 . "TEXT,MTEXT")
            (z-ss-filter-layer-no-loced-freeze)
            ) ;_ list
          ) ;_ ssget
    ) ;_ setq
  (if (and ss (> (sslength ss) 0))
    (if  (setq pt_align (getpoint "\nВведите точку выравнивания: "))
      (list ss pt_align)
      ) ;_ if
    ) ;_ if
  ) ;_ defun
;|Исполнительная функция выравнивания текста.
Примеры использования вызова с меню и кнопок:
^C^C^P(z-text-align nil nil "X" "Left")
^C^C^P(z-text-align nil nil "X" "Center")
^C^C^P(z-text-align nil nil "X" "Right")
^C^C^P(z-text-align nil nil "Y" "Left")
^C^C^P(z-text-align nil nil "Y" "Center")
^C^C^P(z-text-align nil nil "Y" "Right") |;
(defun z-text-align
       (ss pt_align align_axes align_side / ent ent_lst pt_text)
  (vla-StartUndoMark
    (vla-Get-ActiveDocument (vlax-Get-Acad-Object))
    ) ;_ vla-StartUndoMark
  (setvar "cmdecho" 0)
  (if (or (not ss) (not pt_align))
    (setq ss-pt (z-text-align-input-ss-pt))
    ) ;_ if
  (if ss-pt
    (progn
      (setq ss (car ss-pt))
      (setq pt_align (cadr ss-pt))
      (setq ent_lst (vl-remove-if
              '(lambda (a) (listp a))
              (mapcar 'cadr (ssnamex ss))
              ) ;_ vl-remove-if
        ) ;_ setq
      (foreach ent (vl-remove-if-not
             '(lambda (ent)
            (= "TEXT" (cdr (assoc 0 (entget ent))))
            ) ;_ lambda
             ent_lst
             ) ;_ vl-remove-if-not
    (setq pt_text (assoc 10 (entget ent)))
    (z-ent-mod-lst
      ent
      (cond    ((= align_side "Left")
         '((72 . 0) (73 . 0) (11 0.0 0.0 0.0))
         )
        ((= align_side "Center")
         '((72 . 1) (73 . 0) (11 0.0 0.0 0.0))
         )
        ((= align_side "Right")
         '((72 . 2) (73 . 0) (11 0.0 0.0 0.0))
         )
        ) ;_ cond
      ) ;_ z-ent-mod-lst
    (z-ent-mod
      ent
      (if (= align_side "Left")
        10
        11
        ) ;_ if
      (if (= align_axes "X")
        (list (car pt_align) (caddr pt_text) 0)
        (list (cadr pt_text) (cadr pt_align) 0)
        ) ;_ if
      ) ;_ mapcar
    ) ;_ foreach
      (foreach ent (vl-remove-if
             '(lambda (ent)
            (= "TEXT" (cdr (assoc 0 (entget ent))))
            ) ;_ lambda
             ent_lst
             ) ;_ vl-remove-if-not
    (z-ent-mod
      ent
      71
      (+
        (* (fix (/ (1- (cdr (assoc 71 (entget ent)))) 3)) 3)
        (cond ((= align_side "Left")
           1
           )
          ((= align_side "Center")
           2
           )
          ((= align_side "Right")
           3
           )
          ) ;_ cond
        ) ;_ +
      ) ;_ z-ent-mod
    (z-ent-mod
      ent
      10
      (if (= align_axes "X")
        (list (car pt_align) (caddr (assoc 10 (entget ent))) 0)
        (list (cadr (assoc 10 (entget ent))) (cadr pt_align) 0)
        ) ;_ if
      ) ;_ z-ent-mod
    ) ;_ foreach
      ) ;_ progn
    ) ;_ if
  (vla-EndUndoMark
    (vla-Get-ActiveDocument (vlax-Get-Acad-Object))
    ) ;_ vla-EndUndoMark
  (setvar "cmdecho" 1)
  (princ)
  ) ;_ defun
;;;
;;;!!!Вспомогательные функции!!!
;;;
;;;Задание свойства объекта
;;;(z-ent-mod (ssname (ssget '((0 . "TEXT"))) 0) 1 "AAAA")
(defun z-ent-mod (ename bit value / ent_list old_dxf new_dxf)
  (setq ent_list (entget ename))
  (setq new_dxf (cons bit value))
  (if (/= 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))
    ) ;_ if
        ) ;_ entmod
      (entupd ename)
      ) ;_ progn
    ) ;_ if
  ename
  ) ;_ defun
;;;_Задание свойств объекта списком свойств
;|(z-ent-mod-lst
    (ssname (ssget '((0 . "TEXT"))) 0)
    '((1 . "AAAA") (62 . 1))
    ) ;_ z-ent-mod-lst
|;
(defun z-ent-mod-lst (ename lst_data / raw_data)
  (setq raw_data (entget ename))
  (mapcar '(lambda (a)
       (setq raw_data (if  (assoc (car a) raw_data)
            (subst a (assoc (car a) raw_data) raw_data)
            (append raw_data (list a))
            ) ;_ if
       ) ;_ setq
       ) ;_ lambda
    lst_data
    ) ;_ mapcar
  (entmod raw_data)
  (entupd ename)
  ) ;_ defun
;|(z-layer-lst-no-loced-freeze)
Возвращет список всех не заблокированых и не замороженых слоёв|;
(defun z-layer-lst-no-loced-freeze ()
  (vl-remove-if-not
    '(lambda (layer)
       (= (cdr (assoc 70 (entget (tblobjname "layer" layer)))) 0)
       ) ;_ lambda
    (acad_strlsort (ai_table "layer" 0))
    ) ;_ vl-remove-if-not
  ) ;_ defun
;|(z-ss-filter-layer-no-loced-freeze)
Возвращет список '(8 . "0,Defpoints ...")
не заблокированых и не замороженых слоёв
для использования как фильтра в функции ssget
(ssget (list (z-ss-filter-layer-no-loced-freeze))|;
(defun z-ss-filter-layer-no-loced-freeze ()
  (cons    8
    (vl-string-trim
      ","
      (apply 'strcat
         (mapcar '(lambda (a) (strcat a ","))
             (z-layer-lst-no-loced-freeze)
             ) ;_ mapcar
         ) ;_ apply
      ) ;_ vl-string-trim
    ) ;_ cons
  ) ;_ defun

Примеры вызова:
в командной строке z-text-align
Из меню или на кнопках:

^C^C_z-text-align
^C^C^P(z-text-align nil nil "X" "Left")
^C^C^P(z-text-align nil nil "X" "Center")
^C^C^P(z-text-align nil nil "X" "Right")
^C^C^P(z-text-align nil nil "Y" "Left")
^C^C^P(z-text-align nil nil "Y" "Center")
^C^C^P(z-text-align nil nil "Y" "Right")

Р.S.
1)Лично я не пользуюсь вызовом данной команды в командной строке, удобнее кликать по кнопочкам типа выпадающего тоолбара (Flyout).

Re: LISP. Выравнивание текстов по горизонтали или вертикали

И где здесь программа? Ошметки какие- то.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
Так всегда. :(
Я напоминал о использовании библиотеке функций (Ошметки какие- то). :(
Копируйте весь код в один файл. Загружаете и запускаете по вызовам, приведёным в примерах.
Успехов!

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
А, что нельзя оформить все это в виде понятном для рядового пользователя?
Или опять, только, что бы "приколотся"?

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
Я два раза комбинировал. И оба раза не работало. Если третий раз не будет работать... Уж извините.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
У меня есть большая библиотека вспомогательных функций. И их вписывание в тело программы , при выкладывании на форум, делаю по максимуму. Или вы хотите увидеть десяток вложенных функций, которые я использую для данной программы, могу приложить.
В итоге я бы не приводил бы код на всеобщее обозрение, а дал бы ссылку на файл fas (только для использования, без коректирования и критики).

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
Какие сообщения выдаёт акад?

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
А никаких. Скорей всего, что собрано мной неправильно из кусков.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Попробуйте скопировать весь код и сохранить его как отдельный лисп файл. Загрузить его последним (сомневаюсь, что гдето ранее использовали функции с одинаковыми с моими названиями).

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
Первую скобку не забыли?
При копировании кода с форума, это часто случается.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
А что, разве нельзя собрать воедино и неделимо? А с секретными кодами можно поступить следующим образом: откомпиллировать и дать линк для скачивания. Главное, что бы программа была хорошей для Вас и одного, двух пользователей. А если будете оглядываться на "критиков"- ничего не получится.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Forma пишет:

И где здесь программа? Ошметки какие- то.

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

Секретных кодов нет.
Если не знаете в программировании, что такоё программа, а что такоё подпрограмма или функция то учите матчасть или не задавайте тупых вопросов по десять раз, а пользуйтесь прогой и благодарите судьбу, что Вам ещё помогают.
Давайте не засорять форум.
Я Вас не знаю и Вы Меня не знаете. Все дружно мирно разбежались. ОК.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> den-si
прошу удалить сообщения не косающиеся данной темы.
P.S.
forma меня уже достал. Тестер класный но со своими вывихами и подходами, а также претензиями.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
Ты же меня сам приглашал.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
Так прога работает или нет?

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
Ты в порядке?

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Да

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
А это, что было?:

задавайте тупых вопросов по десять раз, а пользуйтесь прогой и благодарите судьбу, что Вам ещё помогают.
Давайте не засорять форум.
Я Вас не знаю и Вы Меня не знаете. Все дружно мирно разбежались. ОК.

forma меня уже достал. Тестер класный но со своими вывихами и подходами, а также претензиями.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Forma
Что есть то есть.
Вы жутко мне не нравитесть.
Давайте только конкретные замечания и будем нормально общатся в рамках форума.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> ZZZ
Нет. Не будем.

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Вот и хорошо

Re: LISP. Выравнивание текстов по горизонтали или вертикали

Виталий. Скопировал код в файл, загрузил, ввел команду:

z-text-align

и с ходу получил:

Команда: _z-text-align
no function definition: AI_TABLE
 Аварийное завершение команды!
Команда:

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Владимир Громов
ИМХО: в функции (z-layer-lst-no-loced-freeze) - она предпоследняя в приведенном коде, можно, наверно, закомментировать строку (acad_strlsort (ai_table "layer" 0)) - я так полагаю, что это сделано только для удобства представления. Каду все равно. Если я не прав, пусть автор подключится. Может, функция станет работать в таком виде:

;|(z-layer-lst-no-loced-freeze)
Возвращет список всех не заблокированых и не замороженых слоёв|;
(defun z-layer-lst-no-loced-freeze ()
  (vl-remove-if-not
    '(lambda (layer)
       (= (cdr (assoc 70 (entget (tblobjname "layer" layer)))) 0)
       ) ;_ lambda
    ) ;_ vl-remove-if-not
  ) ;_ defun

---
ИМХО

Re: LISP. Выравнивание текстов по горизонтали или вертикали

> Владимир Громов
Отсутствие AI_TABLE на Вашем акаде я никак объяснить не могу.
Вам наверное прийдётся выбрасывать функции фильтра заблокированных слоёв
z-layer-lst-no-loced-freeze
z-ss-filter-layer-no-loced-freeze
Правда если честно не всегда эти функции надо.
Прийдётся выкручиватся:

;|(z-layer-lst-no-loced-freeze)
Возвращет список всех не заблокированых и не замороженых слоёв|;
(defun z-layer-lst-no-loced-freeze ()
  (vl-remove-if-not
    '(lambda (layer)
       (= (cdr (assoc 70 (entget (tblobjname "layer" layer)))) 0)
       ) ;_ lambda
    (acad_strlsort (z-layer-lst))
    ) ;_ vl-remove-if-not
  ) ;_ defun
;;;  (z-layer-lst)
(defun z-layer-lst (/ layer_lst layer)
  (setq layer_lst (list (cdr (assoc 2 (tblnext "layer" t)))))
  (while (setq layer (tblnext "layer"))
    (setq layer_lst (cons (cdr (assoc 2 layer)) layer_lst))
    ) ;_ while
  layer_lst
  ) ;_ defun