Under Options, select E to select a rectangular box, upper left, lower right, after the same interval as vertical alignment!
my routine is ~~
;;--------------------=={ Align Text }==----------------------;;
;thanks Lee-Mac & PTE:
(defun c:AlignText ( / ss d h h` f objs c plst sp grr g1 g2 lst len p i ii iii k n u a X_dist point_dist
center Hor_dist Ver_dist msg
LM:startundo
LM:endundo
*error*
LM:GetTextBox
PTE:sortobj
KT:ss->objs
KT:ChangeAlignmentText
)
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-endundomark doc)
)
)
(defun *error* ( msg )
(if d (LM:endundo d))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix )
;; ?Lee Mac 2010
(setq dx (lambda ( x l ) (cdr (assoc x l))))
(if
(setq lst
(cond
(
(member (dx 0 (setq l (entget ent))) '("TEXT" "ATTRIB"))
(setq base (dx 10 l) rotn (dx 50 l))
(
(lambda ( data )
(mapcar
(function
(lambda ( funcs )
(mapcar
(function
(lambda ( func )
((eval (car func)) ((eval (cdr func)) data) off)
)
)
funcs
)
)
)
(list
(list (cons '- 'caar ) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '+ 'cadadr))
(list (cons '- 'caar ) (cons '+ 'cadadr))
)
)
)
(textbox l)
)
)
(
(eq "MTEXT" (dx 0 l))
(setq norm (dx 210 l) base (trans (dx 10 l) 0 norm)
rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm))
w (dx 42 l) h (dx 43 l)
)
(
(lambda ( org )
(mapcar
(function
(lambda ( o ) (mapcar '+ org o))
)
(list
(list (- off) (- off))
(list (+ w off) (- off))
(list (+ w off) (+ h off))
(list (- off) (+ h off))
)
)
)
(
(lambda ( j )
(list
(cond
(
(member j '(2 5 8)) (/ w -2.)
)
(
(member j '(3 6 9)) (- w)
)
( 0. )
)
(cond
(
(member j '(1 2 3)) (- h)
)
(
(member j '(4 5 6)) (/ h -2.)
)
( 0. )
)
)
)
(dx 71 l)
)
)
)
)
)
(progn
(setq matrix
(list
(list (cos rotn) (sin (- rotn)) 0.)
(list (sin rotn) (cos rotn) 0.)
(list 0. 0. 1.)
)
)
(mapcar
(function
(lambda ( point )
(mapcar '+
(mapcar
(function
(lambda ( r ) (apply '+ (mapcar '* r point)))
)
matrix
)
(reverse (cdr (reverse base)))
)
)
)
lst
)
)
)
)
(defun PTE:sortobj
( olst typ tol /
typ objs opt npt lst data lst rev sx sy dxf x y
PTE:s1 PTE:s2 PTE:s3 PTE:s4
)
(defun rev (ls f) (mapcar '(lambda (l)(if (setq f (not f)) (reverse l) l)) ls))
(defun sx (objs) (vl-sort objs '(lambda (a b) (< (x a) (x b)))))
(defun sy (objs) (vl-sort objs '(lambda (a b) (< (y a) (y b)))))
(defun dxf (o c) (cdr (assoc c (entget (vlax-vla-object->ename o)))))
(defun x (o) (car (dxf o 10)))
(defun y (o) (cadr (dxf o 10)))
(setq typ (vl-string->list (strcase typ)))
(if (member (car typ) '(76 82))
(setq PTE:s1 sy PTE:s2 y PTE:s3 sx PTE:s4 rev)
(setq PTE:s1 sx PTE:s2 x PTE:s3 sy PTE:s4 rev)
)
(setq objs (PTE:s1 olst) opt (PTE:s2 (car objs)))
(foreach o objs
(if (< tol (abs (- (setq npt (PTE:s2 o)) opt)))
(setq lst (cons data lst) data (list o) opt npt)
(setq data (cons o data))
)
)
(setq lst (mapcar '(lambda (l) (PTE:s3 l))(cons data lst))
lst (if (member (cadr typ) '(85 82)) (reverse lst) lst)
lst (if (member (car typ) '(68 76)) (mapcar '(lambda (l) (reverse l)) lst) lst)
lst (if (/= (car typ) (caddr typ))(PTE:s4 lst t) lst)
)
)
(defun KT:ss->objs (ss)
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
(defun KT:ChangeAlignmentText ( objs lst s dis arr count / KT:pt->center p1 p2)
(defun KT:pt->center (p1 p2)
(mapcar '(lambda (a b)(* (+ a b) 0.5))p1 p2)
)
(if (and (eq a 2)(eq center nil))
(progn
(setq p1 (getpoint "\nSpecify point : ")
p2 (getpoint p1 "\nSecond point : ")
)
(setq center (KT:pt->center p1 p2))
(setq Hor_dist (abs (car (mapcar '- p1 p2))));(distance (list(car p1) 0.)(list (car p2) 0.)))
(setq Ver_dist (abs (cadr (mapcar '- p1 p2))));(distance (list 0. (cadr p1))(list 0. (cadr p2))))
(prompt msg)
)
)
; (setq center nil H_dist nil V_dist nil)
(mapcar '(lambda (o l count)
(if (eq a 2)
(vla-put-Alignment o 10)
(vla-put-Alignment o arr)
)
(vlax-put o 'TextAlignmentPoint
(trans
(cond
( (eq a 0)
(list(+ (car s) dis)(cadr l))
)
( (eq a 1)
(list(+ (car s) dis)(- (cadr s)(* f count)))
)
( (eq a 2)
(list (+ (car center)(* Hor_dist u)) (- (cadr center)(* Ver_dist count)))
)
( (eq a 3)
(list(+(car g2) dis)(- (cadr g2)(-(cadr s)(cadr l))));grread좌표
)
)
1 0
)
)
)
objs lst count
)
)
;Main~~~
(if (setq ss (KT:ss->objs (ssget "_:L" '((0 . "TEXT")))))
(progn
(setq d (vla-get-activedocument (vlax-get-acad-object)))
(setq i 0 k 0 n 0 u 0 a 0 X_dist '(0.) ii '() iii nil)
(setq h (car (vl-sort (mapcar 'vla-get-height ss) '>)))
; (setq msg "\n<Tap>:정렬위치, <P>:삽입점 변경, <V>:수직정렬, <E>:등간격 정렬, <H>:수평정렬")
(setq msg "\n<Tap>:Alignment, <P>:Change InsertPoint, <V>:Vertical-align, <E>:Table-align, <H>:Horizontal-align")
;;;;;;;;;;;;;;;;
(setq f (* h 1.5))
(setq objs (PTE:sortobj ss "drd" h))
(setq c (length objs))
(foreach n (mapcar '(lambda (x) (length x)) objs)
(repeat n (setq ii (cons (rem i n) ii)) (setq i (1+ i)))
(setq iii (cons (reverse ii) iii))
(setq i 0 ii nil)
)
;;;;;;;;;;;;;;;;
(repeat c
(setq Plst
(cons
(mapcar
'(lambda (x)
(vlax-get x 'InsertionPoint)
)
(nth n objs)
)
Plst
)
)
(setq n (1+ n))
)(setq Plst (reverse Plst) n 0)
;;;;;;;;;;;;;;;;
(setq sp (mapcar 'car Plst))
(repeat (1- c)
(setq X_dist
(cons
(- (car (nth (1+ k) sp))(car (car sp)))
X_dist
)
)
(setq k (1+ k))
)(setq X_dist (reverse X_dist))
;;;;;;;;;;;;;;;;
(prompt msg)
;Grread Start~~~~
(LM:startundo d)
(while
(progn
(setq grr (grread t 15 0) g1 (car grr) g2 (cadr grr))
(cond
( (= g1 5) (redraw)
(repeat c
(KT:ChangeAlignmentText
(nth u objs) ;객체 리스트
(nth 0 plst) ;객체좌표 리스트
(nth 0 sp) ;리스트별 첫번째 객체 좌표
(nth u X_dist) ;X 좌표 간격
(+ i 12)
(nth u iii) ;Y 좌표 수량
)
(setq u (1+ u))
)
(setq u 0)
t
)
( (and (= g1 2) (= g2 9)) ;tap
(setq i (rem (setq i (+ i 1)) 3) u 0)
)
( (and (= g1 2) (or (= g2 118)(= g2 86))) ;V
(setq a (rem (setq a (+ a 1)) 2) u 0)
)
( (and (= g1 2) (or (= g2 101)(= g2 69))) ;E
(setq a 2)
)
( (and (= g1 2) (or (= g2 112)(= g2 80))) ;P
(setq a 3) ;(rem (setq n (+ n 1)) 2) u 0)
)
( (and (= g1 2) (or (= g2 104)(= g2 72))) ;H
(foreach o (apply 'append objs)
(setq lst (LM:GetTextBox (vlax-vla-object->ename o) 0))
(setq len (+ (fix (- (caadr lst) (caar lst))) 1))
(if (eq p nil)
(setq p (polar (getpoint "\nSpecify point : ") 0 (+ f len)))
(setq p (polar p 0 (+ f len)))
)
(vlax-put o 'Alignment acAlignmentBottomRight)
(vlax-put o 'TextAlignmentPoint (trans p 1 0)) ;(trans p 1 0)은 절대좌표계로 리턴... (trans p 0 1)은 상대좌표..
)
)
( (or (= g1 3) (member (cadr grr) '(0 13 32))) nil)
(t)
)
)
)
(LM:endundo d)
)
)
(princ)
)
(vl-load-com)