[编程交流] 过程选择集

(if (setq ss (ssget '((0 . "TEXT"))))
 (vl-sort
   ((lambda (i / lst)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq lst (cons e lst))
      )
    )
     -1
   )
   (function (lambda (a b) (> (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
 )
)

; TXTSPC command is for adjusting the spacing between existing TEXT
; By G. Ramesh, NPCC, Abu Dhabi.
(defun C:TXTSPC (/ d e1 elist fpt el1 el2 sp1 sp2 r-ang dis dif i)
 (setvar "highlight" 1)
 (command ".undo" "g")
 (setq d (getdist "\nSpacing required between lines: "))
 (prompt
   "\nSelect the TEXT entities one by one starting from the top . . ."
 )
 (setq e1    (entsel "\nSelect first TEXT: ")
elist '()
i     0
 )
 (while e1
   (redraw (car e1) 3)
   (setq elist (append elist (list (car e1)))
  e1 (entsel "\nSelect next TEXT: ")
   )
 )
 (foreach n elist (redraw n 1))
 (setq el1 (entget (nth 0 elist)))
 (if (/= (cdr (assoc 72 el1)) 0)
   (setq code 11)
   (setq code 10)
 )
 (setq fpt (cdr (assoc code el1)))
 (repeat (1- (length elist))
   (setq el1 (entget (nth i elist))
  el2 (entget (nth (1+ i) elist))
  sp1 (cdr (assoc code el1))
  sp2 (cdr (assoc code el2))
  r-ang (cdr (assoc 50 el1))
  dis (- (cadr sp1) (cadr sp2))
  dif (- d dis)
  sp2 (polar fpt (- r-ang (/ pi 2)) (* (1+ i) d))
  el2 (subst (append (list code) sp2) (assoc code el2) el2)
  i (1+ i)
   )
   (entmod el2)
 )
 (foreach n elist (redraw n 1))
 (command ".undo" "end")
 (prin1)
)

< Scroll down to see solution >
(defun c:test ( / ss )
 (vl-load-com)
 ;; © Lee Mac 2010
 (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
   (
     (lambda ( i / e l p h a )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (entget e) l ))
       )
       (setq l
         (vl-sort l
           (function
             (lambda ( a b )
               (> (cadr (LM:GetTextInsertion a)) (cadr (LM:GetTextInsertion b)))
             )
           )
         )
       )
       (setq p (LM:GetTextInsertion (car l)) h (* 1.5 (dxf 40 (car l))) a (/ (* 3 pi) 2.))
       (
         (lambda ( j )
           (while (setq l (cdr l))
             (LM:PutTextInsertion (car l) (polar p a (* (setq j (1+ j)) h)))
           )
         )
         0
       )
     )
     -1
   )
 )
 (princ)
)
(defun dxf ( code lst ) (cdr (assoc code lst)))
(defun LM:GetTextInsertion ( eList )
 ;; © Lee Mac 2010
 (dxf
   (if (vl-every 'zerop
         (mapcar 'dxf '(72 73) (list elist elist))
       )
     10 11
   )
   eList
 )
)
(defun LM:PutTextInsertion ( eList point / code )
 ;; © Lee Mac 2010
 (setq code
   (if (vl-every 'zerop
         (mapcar 'dxf '(72 73) (list elist elist))
       )
     10 11
   )
 )
 (entupd
   (cdr
     (assoc -1
       (entmod
         (subst (cons code point) (assoc code elist) elist
         )
       )
     )
   )
 )
)

<Scroll to see>
(defun c:ALT (/ foo lst)
 ;; Align TEXT objects
 ;; Alan J. Thomspon, 08.02.10
 (vl-load-com)
 (defun foo (o / a b)
   (vla-getboundingbox o 'a 'b)
   (vlax-safearray->list a)
 )
 (if (and (setq lst (vl-sort ((lambda (/ ss l)
                                (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
                                  (progn
                                    (vlax-for x (setq ss (vla-get-activeselectionset
                                                           (cond (*AcadDoc*)
                                                                 ((setq *AcadDoc*
                                                                         (vla-get-activedocument (vlax-get-acad-object))
                                                                  )
                                                                 )
                                                           )
                                                         )
                                                )
                                      ;; (XYZ, height, object)
                                      (setq l (cons (list (foo x) (vla-get-height x) x) l))
                                    )
                                    (vla-delete ss)
                                    l
                                  )
                                )
                              )
                             )
                             (function (lambda (a b) (> (cadar a) (cadar b))))
                    )
          )
          (not (initget 0 "Single Double"))
          (setq *ALT:Space*
                 (cond ((getkword (strcat "\nSpecify spacing [single/Double] <"
                                          (cond (*ALT:Space*)
                                                ((setq *ALT:Space* "Single"))
                                          )
                                          ">: "
                                  )
                        )
                       )
                       (*ALT:Space*)
                 )
          )
     )
   ((lambda (d m)
      (foreach x (cdr lst)
        (vla-move (caddr x)
                  (vlax-3d-point (car x))
                  (vlax-3d-point (polar (caar lst) (* pi 1.5) (setq d (+ d (* m (cadr x))))))
        )
      )
    )
     0.
     (if (eq *ALT:Space* "Single")
       1.5
       3.
     )
   )
 )
 (princ)
)