Тема: 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).