Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
54 replies to this topic

#1 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 16 September 2009 - 05:06 AM

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.
Hình đã gửi

(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
  • 3

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 16 September 2009 - 07:27 AM

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.
Hình đã gửi


(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è!!!!
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#3 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 14 October 2009 - 07:29 AM

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.
Hình đã gửi


(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.c...showtopic=13897
  • 0

#4 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 16 October 2009 - 05:20 AM

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.c...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)
)

  • 4

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#5 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 16 October 2009 - 07:24 AM

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)
)


  • 0
Hoàng Giang

#6 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 16 October 2009 - 07:25 AM

Gửi tặng các bác Lisp căn lề chạy rất ổn định nè : Lệnh là CLE
http://www.mediafire...04e75f6e8ebb871
  • 1
Hoàng Giang

#7 daotac541

daotac541

    biết vẽ circle

  • Members
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 21 October 2009 - 11:48 PM

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 !!!!!!!!!!
  • 0

#8 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 26 October 2009 - 06:21 PM

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ứ?
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#9 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 30 October 2009 - 05:28 AM

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ứ?

của bạn đây ! đủ bộ hết, lệnh là Cdo, cha, ddd, ddt nhé !
http://www.mediafire...f1b77d2eb488dac
  • 0
Hoàng Giang

#10 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 31 October 2009 - 01:04 AM

của bạn đây ! đủ bộ hết, lệnh là Cdo, cha, ddd, ddt nhé !
http://www.mediafire...f1b77d2eb488dac

Bạn hâm ah? Hình đã gửi
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#11 cungkeng

cungkeng

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 31 October 2009 - 11:09 AM

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.
Hình đã gửi


(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


  • 0

#12 cungkeng

cungkeng

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 31 October 2009 - 11:11 AM

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.
Hình đã gửi


(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!
  • 0

#13 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 31 October 2009 - 11:54 AM

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.
  • 0
Hoàng Giang

#14 thanh50cd5

thanh50cd5

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 December 2009 - 05:41 AM

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???
  • 0

#15 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 12 December 2009 - 09:51 AM

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???

Hình đã gửi
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ẽ.
  • 1

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#16 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 12 December 2009 - 12:17 PM

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ể.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#17 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 12 December 2009 - 01:42 PM

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!
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#18 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 12 December 2009 - 02:47 PM

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!
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#19 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 12 December 2009 - 04:04 PM

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.
Hình đã gửi


(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.
  • 0

#20 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 12 December 2009 - 05:08 PM

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?
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D