Lisp giãn text

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=57792&st=20

;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai


(defun c:dk (/ oldos p d enlst i ht cn cd ort)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ;;;;; p (getpoint "\n Chon diem chuan ")
d (getreal "\n Nhap khoang cach giua cac text: ") )
(setq ort (getstring "\n Text co dinh nam ben Trai hay Phai <T or P>: "))
(prompt "\n Chon nhom text can sap xep")
(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
(while enlst
(command "undo" "be")
(setq i 0)
(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
(if (= (strcase ort) "T")
(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
(cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst)))) )
cn (cdr (assoc 72 (entget (car enlst))))
cd (cdr (assoc 73 (entget (car enlst))))
)
(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
(cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst)))) )
cn (cdr (assoc 72 (entget (last enlst))))
cd (cdr (assoc 73 (entget (last enlst))))
enlst (reverse enlst)
)
)
(foreach en enlst
(setq encode (entget en)
ht (cdr (assoc 40 encode))
encode (subst (cons 72 cn) (assoc 72 encode) encode)
encode (subst (cons 73 cd) (assoc 73 encode) encode)
)
(if (= (strcase ort) "T")
(setq encode (subst (cons 11 (list (+ (car p) (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
(setq encode (subst (cons 11 (list (- (car p) (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
)
(entmod encode)
(setq i (1+ i))
)
;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
;;; (if (= (strcase ans) "Y")
;;; (progn
(prompt "\n Hay chon nhom text can sap xep tiep theo")
(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
;;; )
;;; (setq enlst nil)
;;; )
(command "undo" "e")
)
(setvar "osmode" oldos)

(princ)
)