Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 LoveLisp

LoveLisp

    biết lệnh extend

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

Đã gửi 26 February 2013 - 04:43 PM

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


  • 0

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 27 February 2013 - 07:05 AM

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


  • 1

#3 LoveLisp

LoveLisp

    biết lệnh extend

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

Đã gửi 27 February 2013 - 09:17 AM

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


Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 27 February 2013 - 09:35 AM

  • 0

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 27 February 2013 - 09:59 AM

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


  • 1

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 February 2013 - 11:32 AM

Ý 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 ^^


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 LoveLisp

LoveLisp

    biết lệnh extend

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

Đã gửi 27 February 2013 - 01:19 PM

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:


  • 0

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 27 February 2013 - 02:19 PM

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?


  • 1

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 27 February 2013 - 10:03 PM

Ý 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.


 


  • 1

#9 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 February 2013 - 10:49 PM

Khó phết ấy chứ ^^


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 February 2013 - 06:44 AM

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.c...3/4652_cchu.rar


  • 2