[Sưu tầm]Lisp căn lề chữ

[font=Courier New]********************CAN DONG TEXT*************************
;Sap xep cac dong text deu nhau theo 1 kieu canh le, lay text goc lam chuan.
(defun c:CLT ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
(setq oldos (getvar "osmode")) (setvar "osmode" 0)
(prompt "Chon nhom Text: ")
(setq ss (ssget '((0 . "TEXT"))))
(if (not tyledong) (setq tyledong 1.5))
(setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <" (rtos tyledong 2 2) ">: ")))
(if tyledong1 (setq tyledong tyledong1))
(setq lst1 '(("L" 0 0) ("C" 1 0) ("R" 2 0)))
(initget 1 "C L R")
(setq ki (getkword "Enter an option [Center/Left/Right]: "))
(setq tch (car (entsel "Chon Text chuan: ")))
(if (= 0 (cdr (assoc 72 (entget tch))))
(setq vt (cdr (assoc 10 (entget tch))))
(setq vt (cdr (assoc 11 (entget tch)))))
(setq ki1 (cadr (setq ki0 (assoc ki lst1)))
ki2 (last ki0)
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
yht (+ (* linespc (- (length lst) (length (member tch lst)) -1)) (cadr vt)))
(command "undo" "begin")
(foreach e lst
(setq eget (entget e)
dtiep (list (car vt) (setq yht (- yht linespc)) 0)
eget (subst (cons 72 ki1) (assoc 72 eget) eget)
eget (subst (cons 73 ki2) (assoc 73 eget) eget)
eget (if (and (zerop ki1) (zerop ki2))
(subst (cons 10 dtiep) (assoc 10 eget) eget)
(subst (cons 11 dtiep) (assoc 11 eget) eget)))
(entmod eget))
(command "undo" "end")
(setvar "osmode" oldos)
(princ))[/font]