Cải tiến lệnh gạch chân text bằng line.

Nhân có người nhờ cải tiến cái lệnh gạch chân text bằng line theo hướng:
-Line thuộc layer hiện hành.
-Chọn lựa gạch dưới hay gạch trên.
-Cho phép điều chỉnh khoảng cách giữa line và text.
Mình đã chỉnh lại và post lên bạn nào có nhu cầu giống thế thì dùng.

Bạn copy nội dung và tạo file lisp hay tải file về cũng được!

;Viet boi: KTS_DUY BINH SON - QUANG NGAI
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun c:GCM ( )
(command "undo" "be")
(if (null sochia)(setq sochia 5))
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT"))))
(setq i 0)
(setq N (sslength ss))

(initget "Tren Duoi")
(setq kieu (getkword "\nGach phia: Tren/ text: "))

(setq sochiam (dnint "\nKhoang cach line voi text bang do lon text chia "sochia))
(setq sochia sochiam)

(cond
((/= Kieu "Tren")
(gachduoi)
)
((= Kieu "Tren")
(gachtren)
)
)

(command "undo" "end")
(setvar "MODEMACRO" "**duy782006.blogspot.com**")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gachduoi ()
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "object" textent)
(setq tbTB (textbox (list (cons -1 textent)))
ll (car tbTB)
ur (cadr tbTB)
ul (list (car ll) (cadr ur))
lr (list (car ur) (cadr ll))
)
(setq dccc (- (cadr ul) (cadr ll)))
(setq ddccc (/ dccc sochiam))
(command "line" (list (car ll)(- (cadr ll) ddccc)) (list (car ur)(- (cadr ll) ddccc)) "")
(command "ucs" "p")
(setq i (1+ i))
(setvar "osmode" luubatdiem)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gachtren ()
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "object" textent)
(setq tbTB (textbox (list (cons -1 textent)))
ll (car tbTB)
ur (cadr tbTB)
ul (list (car ll) (cadr ur))
lr (list (car ur) (cadr ll))
)
(setq dccc (- (cadr ul) (cadr ll)))
(setq ddccc (/ dccc sochiam))
(command "line" (list (car ll)(+ (cadr ur) ddccc)) (list (car ur)(+ (cadr ur) ddccc)) "")
(command "ucs" "p")
(setq i (1+ i))
(setvar "osmode" luubatdiem)
)
)
;---------------------------------------
(defun nstr (stri def)
(princ stri)
(princ "<")
(princ " ")
(princ def)
(princ ">")
(princ ":")
(princ " ")
);defun nstr
;--------------------
(defun nstr1 (stri)
(princ stri)
(princ "<")
(princ "Nhap vao")
(princ ">")
(princ ":")
(princ " ")
);defun nstr1
;---------------------
(defun nint (prompt def / temp)
(if def
(setq temp (getint (nstr prompt def)))
(setq def (getint (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;---------------------
(defun dnint (prompt def / temp)
(if def
(setq temp (getreal (nstr prompt def)))
(setq def (getreal (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;--------------------
(defun ndist (po prompt def / temp) ;nhan kh/cach va luu gia tri mac dinh
(if def
(setq temp (getdist po (nstr prompt def)))
(setq def (getdist po (nstr1 prompt)))
)if def
(if temp
(setq def temp)
def
);if temp
);defun ndist
;-----------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Tải về

-Thao tác:
+Nhập lệnh: GCM
+Chọn đối tượng (chọn vô tư lisp tự lọc và nhận các đối tượng text) xong thì enter.
+Lisp hỏi Gach phia: Tren/ text: Bạn nhập T thì gạch trên, D thì gạch dưới (enter sẽ mặc định là gạch dưới).
+Lisp hỏi Khoang cach line voi text bang do lon text chia < 5>: Mặc định khoảng cách line với text là 1/5 độ lớn text muốn thay đổi thì bạn gỏ vào, không thì enter.

Tải về