Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
LoveLisp

[Hỏi khó] Canh lề cho Text theo nội dung

Bởi LoveLisp , trong AutoLisp

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

Tue_NV    3.912

Tue_NV
Đã đăng

Có cách nào canh các text thẳng hàng theo dấu "/" không hả các bác?

 

99835_canhletext_1.png

 

 

File chạy thử :

http://www.cadviet.com/upfiles/3/4652_canhchu_1.dwg

 

Ý tưởng nằm trong code :

(defun c:cchu(/ ss i ename kitu Tue-dxf Tue-ent-mod strtrai strphai str pt)
  (vl-load-com)
  (defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
  (defun Tue-ent-mod (dxf ename newValue / entget-ename)
  (setq entget-ename (entget ename))
  (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
    (setq entget-ename (append entget-ename (list (cons dxf newValue))))
  )
  (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
  (entmod entget-ename)
  ename
  )
  (setq kitu "/")
  (if (setq ss (ssget '((0 . "TEXT"))))
   (Progn
    (setq pt (getpoint "\n Diem canh le :"))
    (command "JUSTIFYTEXT" ss "" "R")
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq str (Tue-dxf 1 ename))
      (setq strphai (substr str (+ (vl-string-search kitu str) 2) (strlen str)))
      (Tue-ent-mod 1 ename (setq strtrai (substr str 1 (1+ (vl-string-search kitu str)))))
      (setq instext (Tue-dxf 10 ename))
      (Tue-ent-mod 11 ename (list (car pt) (cadr instext) 0.0))
      (command "JUSTIFYTEXT" ename "" "L")
      (Tue-ent-mod 1 ename (strcat strtrai strphai))
    )
   )
  )
  (princ)
)

  • 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

LoveLisp    21

LoveLisp
Đã đăng (Đă chỉnh sửa)

Hay quá, thật tuyệt vời! Hoàn toàn đáp ứng được yêu cầu!

Tuy nhiên, mình có chỉnh sửa lại code một tý, khi pick nhiều lần thì nó lại gặp lỗi bác ạ! Mong bác xem giúp.

 

;http://www.cadviet.com/forum/topic/69074-hoi-kho-canh-le-cho-text-theo-noi-dung/

(defun c:cchu(/ ss i ename kitu Tue-dxf Tue-ent-mod strtrai strphai str pt)
  ;----------------------------------------------------------------------------------------------------
  ;SUB-FUNCTION
  (defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
 
  (defun Tue-ent-mod (dxf ename newValue / entget-ename)
    (setq entget-ename (entget ename))
    (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
      (setq entget-ename (append entget-ename (list (cons dxf newValue))))
      )
    (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
    (entmod entget-ename)
    ename
    );defun
  ;----------------------------------------------------------------------------------------------------
  ;MAIN FUNCTION
  (vl-load-com)
  (setvar "cmdecho" 0)
  (command ".ucs" "w")
  (command ".undo" "be")
  (setq kitu (getstring "\nCanh le phuong X cho text theo 1 ky tu . Nhap ky tu </>: ")
 kitu (if (/= kitu "") kitu "/"))
  (if (setq ss (ssget (list (cons 0 "TEXT")(cons 1 (strcat "*" kitu "*")))))
    (while (setq pt (getpoint "\nPick diem canh le <enter = Ket thuc>: "))
      (command "JUSTIFYTEXT" ss "" "R")
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
 (setq str (Tue-dxf 1 ename))
 (setq strphai (substr str (+ (vl-string-search kitu str) 2) (strlen str)))
 (Tue-ent-mod 1 ename (setq strtrai (substr str 1 (1+ (vl-string-search kitu str)))))
 (setq instext (Tue-dxf 10 ename))
 (Tue-ent-mod 11 ename (list (car pt) (cadr instext) 0.0))
 (command "JUSTIFYTEXT" ename "" "L")
 (Tue-ent-mod 1 ename (strcat strtrai strphai))
 );while
      );progn
    );if
  (command ".undo" "e")
  (princ)
  );defun

Xin lỗi, thanh công cụ bị mất cặp dấu code rồi, mình không đưa nó vào mã lisp được!

Chỉnh sửa theo phamthanhbinh

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

Hay quá, thật tuyệt vời! Hoàn toàn đáp ứng được yêu cầu!

Tuy nhiên, mình có chỉnh sửa lại code một tý, khi pick nhiều lần thì nó lại gặp lỗi bác ạ! Mong bác xem giúp.

 

;http://www.cadviet.com/forum/topic/69074-hoi-kho-canh-le-cho-text-theo-noi-dung/

(defun c:cchu(/ ss i ename kitu Tue-dxf Tue-ent-mod strtrai strphai str pt)
	  ;----------------------------------------------------------------------------------------------------
	  ;SUB-FUNCTION
	  (defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
	 
	  (defun Tue-ent-mod (dxf ename newValue / entget-ename)
	    (setq entget-ename (entget ename))
	    (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
	      (setq entget-ename (append entget-ename (list (cons dxf newValue))))
	      )
	    (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
	    (entmod entget-ename)
	    ename
	    );defun
	  ;----------------------------------------------------------------------------------------------------
	  ;MAIN FUNCTION
	  (vl-load-com)
	  (setvar "cmdecho" 0)
	  (command ".ucs" "w")
	  (command ".undo" "be")
	  (setq kitu (getstring "\nCanh le phuong X cho text theo 1 ky tu . Nhap ky tu </>: ")
	 kitu (if (/= kitu "") kitu "/"))
	  (if (setq ss (ssget (list (cons 0 "TEXT")(cons 1 (strcat "*" kitu "*")))))
	    (while (setq pt (getpoint "\nPick diem canh le <enter = Ket thuc>: "))
	      (command "JUSTIFYTEXT" ss "" "R")
	      (setq i -1)
	      (while (setq ename (ssname ss (setq i (1+ i))))
	 (setq str (Tue-dxf 1 ename))
	 (setq strphai (substr str (+ (vl-string-search kitu str) 2) (strlen str)))
	 (Tue-ent-mod 1 ename (setq strtrai (substr str 1 (1+ (vl-string-search kitu str)))))
	 (setq instext (Tue-dxf 10 ename))
	 (Tue-ent-mod 11 ename (list (car pt) (cadr instext) 0.0))
	 (command "JUSTIFYTEXT" ename "" "L")
	 (Tue-ent-mod 1 ename (strcat strtrai strphai))
	 );while
	      );progn
	    );if
	  (command ".undo" "e")
	  (princ)
	  );defun

 

1./ Lisp chạy tốt, không lỗi gì

2./ Lisp có tác dụng canh lề cho 1 nhóm kí tự (đương nhiên trong đó sẽ bao gồm 1 kí tự) đó bạn

Nếu trong chuỗi có 2 nhóm kí tự như nhau thì Lisp sẽ canh lề theo nhóm kí tự đầu tiên

3./ Chỉ cần có ý tưởng, khó sẽ trở thành dễ liền happy.png

  • 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

ketxu    2.984

ketxu
Đã đăng

Ý tưởng hay ta :) Đọc code là thấy tất cả bị set về 1 justify hết rồi hén bác ^^

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

LoveLisp    21

LoveLisp
Đã đăng

Có bị lỗi bác ạ, chỉ pick được 14 lần thôi, đến lần thứ 15 là gặp lỗi. Sau đó nếu thoát lệnh và chạy lại thì không chạy được nữa, báo lỗi như thế này:


Command: CCHU
Canh le phuong X cho text theo 1 ky tu . Nhap ky tu </>:
Select objects: Specify opposite corner: 8 found

Select objects:
Pick diem canh le <enter = Ket thuc>: Unknown command "R". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.
Unknown command "L". Press F1 for help.

Pick diem canh le <enter = Ket thuc>:
Command:

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

Có bị lỗi bác ạ, chỉ pick được 14 lần thôi, đến lần thứ 15 là gặp lỗi. Sau đó nếu thoát lệnh và chạy lại thì không chạy được nữa, báo lỗi như thế này:

 

Command: CCHU

Canh le phuong X cho text theo 1 ky tu . Nhap ky tu </>:

Select objects: Specify opposite corner: 8 found

 

Select objects:

Pick diem canh le <enter = Ket thuc>: Unknown command "R". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

Unknown command "L". Press F1 for help.

 

Pick diem canh le <enter = Ket thuc>:

Command:

 

Lovelisp tự chỉnh xem sao. Ý tưởng mình đã nêu trong code minh hoạ, hem lý bó tay sao hả bạn lovelisp?

  • 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

Tue_NV    3.912

Tue_NV
Đã đăng

Ý tưởng hay ta smile.png Đọc code là thấy tất cả bị set về 1 justify hết rồi hén bác ^^

 

Muốn trả lại justify như thưở ban đầu có chi là khó, do mình lười code thôi,

Tue_NV chỉ code cái chính, thêm mắm dặm muối để các bác tự thêm vô vậy....

 

@LoveLisp : cái này do lệnh Justifytext : Vòng lặp chạy 1 lúc thì lệnh gốc Justifytext mất luôn tuỳ chọn [Left/Align/Fit/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR] <Left>: của lệnh Justifytext

Cái này không hiểu nguyên nhân vì lệnh này là lệnh của CAD

 

Cách khắc phục: Viết lại lệnh Justifytext của CAD bằng Lisp

Cái này, để bạn tự suy nghĩ viết nhé. Mình nghĩ bạn làm được.

 

 

  • 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

Tue_NV    3.912

Tue_NV
Đã đăng

Khó phết ấy chứ ^^

 

Với mình thì dễ ẹc.... smile.png

Gửi bạn file cchu.vlx để bạn test xem nè...

Còn code để bạn chủ topic tự viết để nâng cao tay nghề

 

Lisp xử lý được lỗi mà bạn Lovelisp nêu và xử lý được cả việc không đưa về cùng 1 kiểu justyfi của text (Text lúc đầu răng thì sau nó rứa) (theo ý của Ketxu)

 

Lisp đây : http://www.cadviet.com/upfiles/3/4652_cchu.rar

  • 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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×