Chuyển đến nội dung
Diễn đàn CADViet
Thaistreetz

Lisp căn lề text: Left, Center, Right và Fit (giống word)

Bởi Thaistreetz , trong AutoLisp

Các bài được khuyến nghị

Thaistreetz    539

Thaistreetz
Đã đăng

Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

  • Vote tăng 5
  • Vote giảm 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

dkkx3a    59

dkkx3a
Đã đăng
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can fit ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Trai")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Đang mày mò cái này, THAI viết rồi thì copy một bản vậy. Thanks cái nè!!!!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Phiphi-    176

Phiphi-
Đã đăng
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

Bác bổ xung thêm sao cho có thể sắp xếp các Text thẳng theo hàng ngang thì perfect. Thank you.

(nhưng không phải dùng lệnh DFX trong Lisp ft_df_dfx.lsp đâu nhé) http://www.cadviet.com/forum/index.php?showtopic=13897

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thaistreetz    539

Thaistreetz
Đã đăng
Bác bổ xung thêm sao cho có thể sắp xếp các Text thẳng theo hàng ngang thì perfect. Thank you.

(nhưng không phải dùng lệnh DFX trong Lisp ft_df_dfx.lsp đâu nhé) http://www.cadviet.com/forum/index.php?showtopic=13897

Thêm lệnh DX: sắp xếp text theo hàng ngang (Đưa các text về cùng toạ độ Y, giữ nguyên toạ độ X)

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun
;====================================================================
;dan deu khoang cach cac hang text theo phuong Y
;====================================================================
(defun ss2ent (ss / sodt index lstent)
(setq 	sodt (if ss (sslength ss) 0)
index 0)
(repeat sodt
(setq 	ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
);setq
);repeat
(reverse lstent)
)
(defun c:df()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))
(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq ym (cadr ptmau))
(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq yi (cadr dcuoi))
(setq ddauu (list (car dcuoi) (- (cadr ddau) (* i kc))))
(if (= yi ym) (setq ptgoc (list (car dcuoi) (- (cadr ddau) (* i kc)))))
(setvar "osmode" 0)
(command "move" e "" dcuoi ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Paragraph TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;======================================================================
;dan deu khoang cach cac text theo phuong X
;======================================================================
(defun c:dfx()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))

(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 di 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq xm (car ptmau))
(foreach e lst
(setq ent (entget e))
(setq pti (cdr(assoc 10 ent)))
(setq xi (car pti))
(setq ddauu (list (+ (car ddau) di (* i kc)) (cadr ddau)))
(if (= xi xm) (setq ptgoc (list (+ (car ddau) di (* i kc)) (cadr ddau))))
(setq TBi  (textbox ent) LCi  (car TBi) RCi (cadr TBi) dii (distance LCi RCi) di (+ di dii))
(setvar "osmode" 0)
(command "move" e "" pti ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Dan deu khoang cach TEXT theo phuong ngang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;==================================================================
;Sap xep text thang hang (co cung tung do Y)
;==================================================================
(defun c:dx()
(setq oldos (getvar "osmode"))
(setq txt (ssget '((0 . "TEXT"))))
(command "undo" "begin")
(setq ym (cadr (cdr(assoc 10 (entget (car (entsel "\nChon text chuan")))))) i 0)
(repeat (sslength txt)
(setq txt_pt (cdr(assoc 10 (entget (ssname txt i)))))
(setq ptcuoi (list (car txt_pt) ym))
(setvar "osmode" 0)
(command "move" (ssname txt i) "" txt_pt ptcuoi)
(setq i (+ i 1))
);repeat
(setvar "osmode" oldos)
(prompt"\n[sap xep text thang hang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)

  • Vote tăng 4

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hhhhgggg    29

hhhhgggg
Đã đăng
Thêm lệnh DX: sắp xếp text theo hàng ngang (Đưa các text về cùng toạ độ Y, giữ nguyên toạ độ X)

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun
;====================================================================
;dan deu khoang cach cac hang text theo phuong Y
;====================================================================
(defun ss2ent (ss / sodt index lstent)
(setq 	sodt (if ss (sslength ss) 0)
index 0)
(repeat sodt
(setq 	ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
);setq
);repeat
(reverse lstent)
)
(defun c:df()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))
(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq ym (cadr ptmau))
(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq yi (cadr dcuoi))
(setq ddauu (list (car dcuoi) (- (cadr ddau) (* i kc))))
(if (= yi ym) (setq ptgoc (list (car dcuoi) (- (cadr ddau) (* i kc)))))
(setvar "osmode" 0)
(command "move" e "" dcuoi ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Paragraph TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;======================================================================
;dan deu khoang cach cac text theo phuong X
;======================================================================
(defun c:dfx()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))

(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 di 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq xm (car ptmau))
(foreach e lst
(setq ent (entget e))
(setq pti (cdr(assoc 10 ent)))
(setq xi (car pti))
(setq ddauu (list (+ (car ddau) di (* i kc)) (cadr ddau)))
(if (= xi xm) (setq ptgoc (list (+ (car ddau) di (* i kc)) (cadr ddau))))
(setq TBi  (textbox ent) LCi  (car TBi) RCi (cadr TBi) dii (distance LCi RCi) di (+ di dii))
(setvar "osmode" 0)
(command "move" e "" pti ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Dan deu khoang cach TEXT theo phuong ngang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;==================================================================
;Sap xep text thang hang (co cung tung do Y)
;==================================================================
(defun c:dx()
(setq oldos (getvar "osmode"))
(setq txt (ssget '((0 . "TEXT"))))
(command "undo" "begin")
(setq ym (cadr (cdr(assoc 10 (entget (car (entsel "\nChon text chuan")))))) i 0)
(repeat (sslength txt)
(setq txt_pt (cdr(assoc 10 (entget (ssname txt i)))))
(setq ptcuoi (list (car txt_pt) ym))
(setvar "osmode" 0)
(command "move" (ssname txt i) "" txt_pt ptcuoi)
(setq i (+ i 1))
);repeat
(setvar "osmode" oldos)
(prompt"\n[sap xep text thang hang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thaistreetz    539

Thaistreetz
Đã đăng
Nhờ bác viết dùm em cái lisp sắp xếp theo trục y ( tương tự lênh dx của bác nhưng là làm với trục y).

Thx bác !!!!!!!!!!

Là thế nào nhỉ? Mình nghĩ lệnh FT là đủ cho mọi trường hợp bạn cần rồi chứ?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cungkeng    0

cungkeng
Đã đăng
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

cungkeng    0

cungkeng
Đã đăng
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

Mình đã thử nhiều lần nhưng đều xuất hiện lỗi.chon cac text can can le ...too many arguments

Trước mình dùng lisp bình thường nhưng dạo này một số lisp rất hay xuất hiện lỗi too many arguments.có thể cho mình hỏi nguyên nhân và cách khắc phục được không??? thanks!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

hhhhgggg    29

hhhhgggg
Đã đăng
Mình đã thử nhiều lần nhưng đều xuất hiện lỗi.chon cac text can can le ...too many arguments

Trước mình dùng lisp bình thường nhưng dạo này một số lisp rất hay xuất hiện lỗi too many arguments.có thể cho mình hỏi nguyên nhân và cách khắc phục được không??? thanks!

Đầu bác Thái có vấn đề à mà ăn nói kiểu đó. Ko hiểu j về điện lại nói lung tung.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

haanh    1.590

haanh
Đã đăng
Sao lips căn lề toàn bay mất tiêu text vậy các đại ca, bay lung tung, mỗi căn lề về 1 vị trí khác nhau là sao???

24255478321.jpg

Em ko dùng Lisp, em căn lề ngay trên text Formatting trên CAD2010 nhưng em dự đoán

có thể vùng gõ text của anh dài quá, sau khi căn lề xong nó chạy ra ngoài vùng nhìn thấy trên màn hình.

Trước khi căn lề anh thử bấm chuột vào hình tam giác mầu xanh kéo ngắn lại xem có được ko???

- Hình 1 và 2 em căn lề phải khi để vùng vẽ dài

- Hình 3 và 4 em căn lề phải khi khi đã kéo ngắn lại vùng vẽ.

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thaistreetz    539

Thaistreetz
Đã đăng
Sao lips căn lề toàn bay mất tiêu text vậy các đại ca, bay lung tung, mỗi căn lề về 1 vị trí khác nhau là sao???

bạn có thể up bản vẽ của bạn lên để mình kiểm tra không?

vì mình viết lisp này trên một bản vẽ mới với tất cả các biến hệ thống thiết lập ở standard nên có thể không lường trước được những thay đổi của một số biến hệ thống khiến lisp chạy không như ý muốn. fiền bạn up bản vẽ mà bạn chạy bị lỗi đến mình nghiên cứu hoàn thiện nó hơn cho mọi trường hợp có thể.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

duy782006    1.533

duy782006
Đã đăng
Tính năng này trong CAD đã có hỗ trợ. Lisp này có tính năng gì nổi trội hơn hẳn so với CAD không?

Cad hổ trợ xếp text bằng lệnh nào vậy bác. Mình hòi thiệt vì cái này chưa biết. Mình cũng phải tự viết lisp cho việc này nhưng chỉ viết cho text thôi chứ không có mtext.

 

@thanh50cd5 : Bạn coi trục tọa độ có đúng là W không!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

master_worse    88

master_worse
Đã đăng
Tính năng này trong CAD đã có hỗ trợ. Lisp này có tính năng gì nổi trội hơn hẳn so với CAD không?
Cad hổ trợ xếp text bằng lệnh nào vậy bác.....

mình cũng không biết. tuongtrang biết thì chỉ giúp với, cam ơn nhiều!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tue_NV    3.912

Tue_NV
Đã đăng
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
......
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
........
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
......

Chào Thaistreetz.

Tue_NV có ý kiến chút nhé :

1. Trong Lisp thể hiện chọn các Text và Mtext như của bạn viết thể hiện qua dòng Code này :

(setq txt (ssget '((0 . "*TEXT"))))

Nhưng khi thể hiện lại thì qua những dòng code mà Tue_NV đã trích dẫn thì toàn bộ MText ban đầu đã chuyển thành Text cả. Như vậy là không phù hợp

2. Bạn xem lại trong code 1 chút nhé. Khi chọn Text chuẩn trúng đối tượng TEXT thì đúng nhưng khi Pick trúng đối tượng MTEXT thì báo lỗi ngay.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

duy782006    1.533

duy782006
Đã đăng
Trang xài CAD 2010 nên không test được LISP này. Nhưng nếu Trang không nhầm thì LISP này chỉ phù hợp cho DText vì MText AutoCAD da ho tro.

 

Trong AutoCAD da dinh nghia rat ro DText va MText:

 

DText: You can use single-line text to create one or more lines of text, where each text line is an independent object that you can relocate, reformat, or otherwise modify.

 

MText: A multiline text (mtext) object includes one or more paragraphs of text that can be manipulated as a single object.

 

LISP cua Thai rat hay nhung cau hoi dat ra la: Lieu khi hoan chinh LISP nay voi cac tinh nang nhu Word thi luc do lieu Dtext co tro thanh MText hay khong?

-Của bạn Thái thì dùng cách khác của mình. Mình thì chỉ áp dụng cho dtext và dùng cách move cái text đi. Mình viết lisp này vì mình dùng dtext chứ không dùng mtext (một phần vì thói quen một phần mình thấy chình sửa dtext dể hơn và nhẹ hơn).

-Mọi người khi viết lisp thì có ý riêng cả, bạn không cần nhưng người khác cần.

-Vì bạn nói"Tính năng này trong CAD đã có hỗ trợ" nên mình giật mình (mình vốn yếu tim bạn lần sau đừng dọa mình nhé).

-Bạn nói "Trong AutoCAD da dinh nghia rat ro DText va MText:" cái này mình không nói là ai cũng biết nhưng cũng có rất nhiều người biết nhưng vì lisp của bạn Thái có sai sót chứ mục đích là canh lề cho nhiều đối tượng chứ không phải là 1 đối tượng. OK?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

duy782006    1.533

duy782006
Đã đăng

Riêng bản thân Duy không thỏa mãn với câu hỏi cũng như câu trả lời của bác tuongtrang nhưng đây là topic của bạn Thaistreetz nên mình không bàn tiếp. Mà hình như dạo này bác tuongtrang rất bận thì phải mình thấy bác không có thời gian gỏ dấu nửa.

Nếu các MOD thấy bài này không phù hợp thì dell vô tư nhé!

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanh50cd5    0

thanh50cd5
Đã đăng
bạn có thể up bản vẽ của bạn lên để mình kiểm tra không?

vì mình viết lisp này trên một bản vẽ mới với tất cả các biến hệ thống thiết lập ở standard nên có thể không lường trước được những thay đổi của một số biến hệ thống khiến lisp chạy không như ý muốn. fiền bạn up bản vẽ mà bạn chạy bị lỗi đến mình nghiên cứu hoàn thiện nó hơn cho mọi trường hợp có thể.

Mình thấy khi mình căn lề trái, phải hay ngang thì text bị chạy sang trái, phải và xuống 1 đoạn cố định

trong bản vẽ up lên mình có chỉ vẽ đoạn đó ra rồi

Bạn xem lại hộ nhé

thanks :(

http://www.mediafire.com/file/dy2nmm2dkli/1 ss tuyen A1.dwg

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thaistreetz    539

Thaistreetz
Đã đăng
Mình thấy khi mình căn lề trái, phải hay ngang thì text bị chạy sang trái, phải và xuống 1 đoạn cố định

trong bản vẽ up lên mình có chỉ vẽ đoạn đó ra rồi

Bạn xem lại hộ nhé

thanks :(

http://www.mediafire.com/file/dy2nmm2dkli/1 ss tuyen A1.dwg

Cảm ơn bạn vì bản vẽ này giúp mình fát hiện ra 4 điểm còn thiếu sót có thể dẫn đến việc lisp không chạy ra kết quả theo ý muốn. 4 điểm đó gồm:

1. Phải thiết lập UCS với giá trị world (như anh Duy đã nói)

2. Phải thiết lập Angbase về giá trị 0

3. Style của các text phải để heigh text có giá trị mặc định là 0.

4. Tất cả các text cần canh lề không được để ở chế độ màu là byblock

Đây là code mình đã sửa lại để phù hợp với những bản vẽ không được thiết lập các điều kiện như 3 điều kiện đầu tiên. vì thời gian này mình bận quá nên ko có thời gian nghiên cứu sửa nốt điều kiện thứ 4. (nó cũng tương đối ít gặp) nên bạn trước khi sử dụng bạn chỉ cần đổi lại màu text khác màu byblock là OK ko vấn đề gì. Nhờ các bác trên diễn đàn sửa nốt giúp mình phần này vậy.

(defun c:ft()
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq ollay (getvar "Clayer"))
(setq olstyle (getvar "textstyle"))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq h (cdr(assoc 40 mau)))
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))
(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))
(setq oldang (getvar "Angbase"))
(command "angbase" 0 "ucs" "w")
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" 0 txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(command "ucs" "p")
(setvar "textstyle" olstyle)
(setvar "angbase" oldang)
(setvar "Clayer" ollay)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun
;=================================================================
;dan deu khoang cach cac hang text theo phuong Y
;=================================================================
(defun ss2ent (ss / sodt index lstent)
(setq 	sodt (if ss (sslength ss) 0)
index 0)
(repeat sodt
(setq 	ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
);setq
);repeat
(reverse lstent)
)
(defun c:df()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))
(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq ym (cadr ptmau))
(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 10 ent)))
(setq yi (cadr dcuoi))
(setq ddauu (list (car dcuoi) (- (cadr ddau) (* i kc))))
(if (= yi ym) (setq ptgoc (list (car dcuoi) (- (cadr ddau) (* i kc)))))
(setvar "osmode" 0)
(command "move" e "" dcuoi ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Paragraph TEXT] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;=========================================================================
;dan deu khoang cach cac text theo phuong X
;=========================================================================
(defun c:dfx()
(setq oldos (getvar "osmode"))
(setq 	ss (ssget '((0 . "*TEXT")))
lst (ss2ent ss)
lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))
);setq
(command "undo" "begin")
(setvar "osmode" 15359)
(setq kc (getdist "\n Nhap khoang cach giua cac text"))

(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 di 0 a2 (ssadd))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq ptmau (cdr(assoc 10 mau)))
(setq xm (car ptmau))
(foreach e lst
(setq ent (entget e))
(setq pti (cdr(assoc 10 ent)))
(setq xi (car pti))
(setq ddauu (list (+ (car ddau) di (* i kc)) (cadr ddau)))
(if (= xi xm) (setq ptgoc (list (+ (car ddau) di (* i kc)) (cadr ddau))))
(setq TBi  (textbox ent) LCi  (car TBi) RCi (cadr TBi) dii (distance LCi RCi) di (+ di dii))
(setvar "osmode" 0)
(command "move" e "" pti ddauu)
(setq 	a2 (ssadd e a2))
(setq i (1+ i))
);foreach
(command "move" a2 "" ptgoc ptmau)
(setvar "osmode" oldos)
(prompt"\n[Dan deu khoang cach TEXT theo phuong ngang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)
;========================================================================
;Sap xep text thang hang (co cung tung do Y)
;========================================================================
(defun c:dx()
(setq oldos (getvar "osmode"))
(setq txt (ssget '((0 . "TEXT"))))
(command "undo" "begin")
(setq ym (cadr (cdr(assoc 10 (entget (car (entsel "\nChon text chuan")))))) i 0)
(repeat (sslength txt)
(setq txt_pt (cdr(assoc 10 (entget (ssname txt i)))))
(setq ptcuoi (list (car txt_pt) ym))
(setvar "osmode" 0)
(command "move" (ssname txt i) "" txt_pt ptcuoi)
(setq i (+ i 1))
);repeat
(setvar "osmode" oldos)
(prompt"\n[sap xep text thang hang] by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
(Princ)
)

@A Tue_NV: vấn đề anh nêu em cũng đã biết ngay trong quá trình viết lisp rồi anh ạ. và đây cũng là chủ đích của em... em có cùng quan điểm với anh Duy, thích sử dụng Dtext hơn là Mtext nên viết code thế này tiện thể covert Mtext về Dtext luôn. Và lisp này viết ra mục đích chủ yếu để áp dụng với Mtext thôi anh ạ.

 

@TuongTrang: Mình cũng đang xài cad2010 và mình vẫn chạy được lisp này như thường. bạn hứng thú thì cứ test bét nhè chè đỗ đen đi, ko vấn đề gì sất <_< .

Về câu hỏi của bạn... Đúng là Mtext đã hỗ trợ các kiểu canh lề từ ngay từ ngày ... Mtext đc sinh ra, cái này thì ai cũng biết. còn với Dtext, mỗi text là một đối tượng riêng lẻ nên theo như hiểu biết của mình thì Cad không có lệnh nào để canh lề cho các đối tượng Dtext riêng lẻ này. cũng chính vì thế nên mình mới viết lisp này để canh lề cho Dtext.

Mình cũng đang hiểu câu hỏi của bạn theo một hướng khác, hình như bạn đang muốn đề cập đến vấn đề convert tất cả các đối tượng Dtext được chọn trở lại Mtext và canh lề cho các dòng trong Mtext mới được tạo ra. Cái này mình chưa làm được và có lẽ mình cũng không muốn làm... vì nhu cầu này hình như rất ít người cần và cũng một fần vì chủ quan của mình, dù thế nào thì mình cũng thích dùng Dtext hơn trong mọi trường hợp.

  • Vote tăng 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×