[编程交流] 文本对齐方式

;;--------------------=={ Align Text }==----------------------;;
;;                                                            ;;
;;  This program enables the user to reposition a selection   ;;
;;  of text objects equispaced by a factor of the text height ;;
;;  and aligned in a direction perpendicular to the rotation  ;;
;;  angle of the text.                                        ;;
;;                                                            ;;
;;  The program assumes all text objects in the selection     ;;
;;  have the same rotation and will align each text object    ;;
;;  using its Text Alignment Point.                           ;;
;;                                                            ;;
;;  The program will perform successfully with text           ;;
;;  constructed in any UCS plane.                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.3    -    23-04-2013                            ;;
;;------------------------------------------------------------;;
;;  Modified to retain vertical spacing - LM 2016-01-15       ;;
;;------------------------------------------------------------;;
(defun c:at ( / *error* ang bpt enx inc ins lst ocs sel vc1 vc2 )
   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   (if (setq sel (ssget "_:L" '((0 . "TEXT"))))
       (progn
           (setq inc (sslength sel)
                 enx (entget (ssname sel (1- inc)))
                 ang (cdr (assoc 50 enx))
                 ocs (trans '(0.0 0.0 1.0) 1 0 t)
                 vc1 (trans (list    (cos ang)  (sin ang)) ocs 0)
                 vc2 (trans (list (- (sin ang)) (cos ang)) ocs 0)
           )
           (repeat inc
               (setq enx (entget (ssname sel (setq inc (1- inc))))
                     lst (cons (list  (trans (aligntext:gettextinsertion enx) (cdr (assoc -1 enx)) 0) enx) lst)
                     ins (cons (caddr (trans (caar lst) 0 vc2)) ins)
               )
           )
           (setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>))
                 bpt (caddr (trans (caar lst) 0 vc1))
           )
           (LM:startundo (LM:acdoc))
           (foreach  itm (cdr lst)
               (setq ins (trans (car itm) 0 vc1))
               (aligntext:puttextinsertion 
                   (trans (list (car ins) (cadr ins) bpt) vc1 (cdr (assoc -1 (cadr itm))))
                   (cadr itm)
               )
           )
           (LM:endundo (LM:acdoc))
       )
   )
   (princ)
)
(defun aligntext:getdxfkey ( enx )
   (if
       (and
           (zerop (cdr (assoc 72 enx)))
           (zerop (cdr (assoc 73 enx)))
       )
       10 11
   )
)
(defun aligntext:gettextinsertion ( enx )
   (cdr (assoc (aligntext:getdxfkey enx) enx))
)
(defun aligntext:puttextinsertion ( ins enx )
   (   (lambda ( key )
           (if (entmod (subst (cons key ins) (assoc key enx) enx))
               (entupd (cdr (assoc -1 enx)))
           )
       )
       (aligntext:getdxfkey enx)
   )
)
;; Start Undo  -  Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)
;; End Undo  -  Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

Specify line spacing factor <use existing spacing>: