Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
taipham

Nhờ Viết Lisp Tạo Table Nhanh Cho Text Có Sẵn

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

Nhờ các anh chị trong diễn đàn viết giúp em lisp tạo khung table cho text hoặc mtext đã có sẵn như sau:

Đánh lệnh KHT: chọn các text, mtext muốn đóng khung, click chọn vị trí đặt khung (bao gồm các text, mtext đã chọn)

Đây là file đính kèm, rất mong sự giúp đỡ của anh chị! Xin cảm ơn!

http://www.cadviet.com/upfiles/5/146422_tao_table_text.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

Đây là lisp table được kẻ bằng line:

http://www.cadviet.com/upfiles/5/141736_text2table.lsp

 

(defun c:tt  (/ Make_line TxtWidth ent first-row hei i ins last-col lst-p1 lst-p2 max-wid old-sty p1 p2 poi-txt ss sty txt widt-txt make_text)
 (defun Make_line  (p1 p2)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "00-TIEU DE"))))
 (defun TxtWidth  (val h / txt minp maxp msp)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getboundingbox txt 'minp 'maxp)
  (vla-erase txt)
  (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))))
 ;; Main
 (if (setq ss (ssget '((0 . "*TEXT"))))
  (progn (setq old-sty (getvar "TEXTSTYLE"))
         (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i))))
                txt (cdr (assoc 1 ent))
                hei (cdr (assoc 40 ent))
                sty (cdr (assoc 7 ent))
                ins (cdr (assoc 10 ent)))
          (setq poi-txt (vl-sort (cons (cons ins txt) poi-txt)
                                 '(lambda (x y)
                                   (cond ((equal (cadr (car x)) (cadr (car y))) (< (car (car x)) (car (car y))))
                                         ((< (cadr (car x)) (cadr (car y)))))))))
         (foreach x  poi-txt
          (if (equal (car (car x)) (car (car (last poi-txt))) (* hei 2))
           (setq last-col (cons x last-col))))
         (setvar "TEXTSTYLE" sty)
         (foreach x last-col (setq widt-txt (cons (TxtWidth (cdr x) hei) widt-txt)))
         (setq max-wid (apply 'max widt-txt))
         (foreach x  poi-txt
          (if (equal (cadr (car x)) (cadr (car (last poi-txt))) hei)
           (setq first-row (cons (car x) first-row)
                 first-row (vl-sort first-row '(lambda (x y) (< (car x) (car y)))))))
         (setq first-row (cons (polar (last first-row) (* pi 0) (+ max-wid (* hei 2))) first-row))
         ;; Dat bang vi tri moi
         (defun make_text  (/ lst-make p-org poi poi-x poi-new first-new)
          (if (setq poi (getpoint "\nDiem chen bang: "))
           (progn (repeat (setq i (sslength ss))
                   (setq lst-make (cons (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330 410))) (entget (ssname ss (setq i (1- i)))))
                                        lst-make)))
                  (setq p-org (car (vl-sort first-row '(lambda (x y) (< (car x) (car y))))))
                  (foreach x  lst-make
                   (setq poi-x (polar (cdr (assoc 10 x)) (angle p-org poi) (distance p-org poi)))
                   (setq x (subst (cons 10 poi-x) (assoc 10 x) x))
                   (entmakex x))
                  (foreach x  first-row
                   (setq poi-new   (polar x (angle p-org poi) (distance p-org poi))
                         first-new (cons poi-new first-new)))
                  (setq first-row first-new))))
         (make_text)
         ;; Ke bang
         (foreach x  first-row
          (setq p1 (polar (polar x (* pi 1.0) hei) (* pi 0.5) (* 1.5 hei)))
          (setq p2 (polar p1 (* pi 1.5) (* 2 hei (length last-col))))
          (setq lst-p1 (cons p1 lst-p1)
                lst-p2 (cons p2 lst-p2))
          (Make_line p1 p2))
         (setq lst-p1 (vl-sort lst-p1 '(lambda (x y) (< (car x) (car y)))))
         (setq i 0)
         (repeat (+ (length last-col) 1)
          (setq p1 (polar (car lst-p1) (* pi 1.5) (* hei 2 i))
                p2 (polar (last lst-p1) (* pi 1.5) (* hei 2 i)))
          (Make_line p1 p2)
          (setq i (1+ i)))
         (setvar "TEXTSTYLE" old-sty)))
 (princ))

1. Dòng đầu tiên phải đầy đủ text (không được bỏ trống như ở cột 1, ô phía dưới) và các text ở hàng này phải thẳng hàng (tức là điểm chèn phải cùng nằm trên đường nằm ngang).

2. Nếu không nhập điểm chèn bảng thì sẽ kẻ bảng đóng khung tại chỗ.

3. Table của cad thì có lẽ không cần như điểm 1, nhưng lisp sẽ dài dòng hơ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

Cảm ơn anh nhiều lắm, nhưng chiều cao của dòng bị cố định hả anh, nếu em dãn dòng ra xa hơn thì text không còn nằm lọt trong table nữa. Vậy anh có thể cho lisp tự động dãn ra theo khoảng cách giữa các text không! hoặc có thể chọn giá trị chiều cao của dòng trước khi chọn điểm chèn (đóng khung)

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

+ Lisp đó cố định chiều cao dòng bằng 2 lần chiều cao text (theo như bản vẽ của bạn).

+ Có thể tự động dãn dòng, nhưng nếu các dòng có khoảng cách không đều nhau thì lại lại sẽ có vấn đề.

+ Texts của bạn các hàng có luôn đều nhau không? Nếu không thì lisp phải viết theo hướng khá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

+ Lisp đó cố định chiều cao dòng bằng 2 lần chiều cao text (theo như bản vẽ của bạn).

+ Có thể tự động dãn dòng, nhưng nếu các dòng có khoảng cách không đều nhau thì lại lại sẽ có vấn đề.

+ Texts của bạn các hàng có luôn đều nhau không? Nếu không thì lisp phải viết theo hướng khác.

Trước khi cho vào table thì em đã dãn đều các dòng rồi anh, nhưng mỗi cụm text lại có giá trị dãn khác nhau anh

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

Anh sửa lại lisp là nhập thêm chiều cao dòng nữa là oke anh, chiều cao dòng không cần phụ thuộc vào chiều cao text cũng được

  • Vote giảm 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

Thì ra nhiều loại bảng, mỗi bảng có khoảng cách giữa các hàng lại khác nhau.

Lisp sửa lại này sẽ tự động dãn hàng theo Text có sẵn:

 

(defun c:tt  (/ Make_line TxtWidth list-deldups ||| ent first-row hei i ins last-col lst-p1 lst-p2 max-wid old-sty p1 p2 poi-txt ss sty txt widt-txt make_text dis)
 (defun Make_line  (p1 p2)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "00-TIEU DE"))))
 (defun TxtWidth  (val h / txt minp maxp msp)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getboundingbox txt 'minp 'maxp)
  (vla-erase txt)
  (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))))
 (defun list-deldups  (lst)
    (if lst
      (cons (car lst) (list-deldups (vl-remove (car lst) (cdr lst))))))
 ;; Main
 (if (setq ss (ssget '((0 . "*TEXT"))))
  (progn (setq old-sty (getvar "TEXTSTYLE"))
         (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i))))
                txt (cdr (assoc 1 ent))
                hei (cdr (assoc 40 ent))
                sty (cdr (assoc 7 ent))
                ins (cdr (assoc 10 ent)))
          (setq poi-txt (list-deldups (cons (cons ins txt) poi-txt))
                poi-txt (vl-sort poi-txt
                                 '(lambda (x y)
                                   (cond ((equal (cadr (car x)) (cadr (car y))) (< (car (car x)) (car (car y))))
                                         ((< (cadr (car x)) (cadr (car y)))))))))
         (foreach x  poi-txt
          (if (equal (car (car x)) (car (car (last poi-txt))) (* hei 2))
           (setq last-col (cons x last-col))))
         (setvar "TEXTSTYLE" sty)
         (foreach x last-col (setq widt-txt (cons (TxtWidth (cdr x) hei) widt-txt)))
         (setq max-wid (apply 'max widt-txt))
         (foreach x  poi-txt
          (if (equal (cadr (car x)) (cadr (car (last poi-txt))) hei)
           (setq first-row (cons (car x) first-row)
                 first-row (vl-sort first-row '(lambda (x y) (< (car x) (car y)))))))
         (setq first-row (cons (polar (last first-row) (* pi 0) (+ max-wid (* hei 2))) first-row))
         ;; Dat bang vi tri moi
         (defun make_text  (/ lst-make p-org poi poi-x poi-j poi-new first-new)
          (if (setq poi (getpoint "\nDiem chen bang: "))
           (progn (repeat (setq i (sslength ss))
                   (setq lst-make (cons (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330 410))) (entget (ssname ss (setq i (1- i)))))
                                        lst-make)))
                  (setq p-org (car (vl-sort first-row '(lambda (x y) (< (car x) (car y))))))
                  (foreach x  lst-make
                   (setq poi-x (polar (cdr (assoc 10 x)) (angle p-org poi) (distance p-org poi))
                         poi-j (polar (cdr (assoc 11 x)) (angle p-org poi) (distance p-org poi)))
                   (setq x (subst (cons 10 poi-x) (assoc 10 x) x))
                   (setq x (subst (cons 11 poi-j) (assoc 11 x) x))
                   (entmakex x))
                  (foreach x  first-row
                   (setq poi-new   (polar x (angle p-org poi) (distance p-org poi))
                         first-new (cons poi-new first-new)))
                  (setq first-row first-new))))
         (make_text)
         ;; Ke bang
         (setq dis (/ (distance (car (car last-col)) (car (last last-col))) (1- (length last-col))))
         (foreach x  first-row
          (setq p1 (polar (polar x (* pi 1.0) hei) (* pi 0.5) (* 0.75 dis))) ;hei 1.5
          (setq p2 (polar p1 (* pi 1.5) (* dis (length last-col)))) ;2 hei
          (setq lst-p1 (cons p1 lst-p1)
                lst-p2 (cons p2 lst-p2))
          (Make_line p1 p2))
         (setq lst-p1 (vl-sort lst-p1 '(lambda (x y) (< (car x) (car y)))))
         (setq i 0)
         (repeat (+ (length last-col) 1)
          (setq p1 (polar (car lst-p1) (* pi 1.5) (* dis i)) ;2 hei
                p2 (polar (last lst-p1) (* pi 1.5) (* dis i))) ;2 hei
          (Make_line p1 p2)
          (setq i (1+ i)))
         (setvar "TEXTSTYLE" old-sty)))
 (princ))​

 

+ Số cột phụ thuộc vào hàng đầu tiên.

+ Các hàng phải có khoảng cách đều.

Mình đang nghiên cứu viết cho AutocadTable, sẽ khắc phục được các vấn đề trên.

  • 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

Thì ra nhiều loại bảng, mỗi bảng có khoảng cách giữa các hàng lại khác nhau.

Lisp sửa lại này sẽ tự động dãn hàng theo Text có sẵn:

(defun c:tt  (/ Make_line TxtWidth list-deldups ||| ent first-row hei i ins last-col lst-p1 lst-p2 max-wid old-sty p1 p2 poi-txt ss sty txt widt-txt make_text dis)
 (defun Make_line  (p1 p2)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "00-TIEU DE"))))
 (defun TxtWidth  (val h / txt minp maxp msp)
  (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getboundingbox txt 'minp 'maxp)
  (vla-erase txt)
  (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))))
 (defun list-deldups  (lst)
    (if lst
      (cons (car lst) (list-deldups (vl-remove (car lst) (cdr lst))))))
 ;; Main
 (if (setq ss (ssget '((0 . "*TEXT"))))
  (progn (setq old-sty (getvar "TEXTSTYLE"))
         (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (setq i (1- i))))
                txt (cdr (assoc 1 ent))
                hei (cdr (assoc 40 ent))
                sty (cdr (assoc 7 ent))
                ins (cdr (assoc 10 ent)))
          (setq poi-txt (list-deldups (cons (cons ins txt) poi-txt))
                poi-txt (vl-sort poi-txt
                                 '(lambda (x y)
                                   (cond ((equal (cadr (car x)) (cadr (car y))) (< (car (car x)) (car (car y))))
                                         ((< (cadr (car x)) (cadr (car y)))))))))
         (foreach x  poi-txt
          (if (equal (car (car x)) (car (car (last poi-txt))) (* hei 2))
           (setq last-col (cons x last-col))))
         (setvar "TEXTSTYLE" sty)
         (foreach x last-col (setq widt-txt (cons (TxtWidth (cdr x) hei) widt-txt)))
         (setq max-wid (apply 'max widt-txt))
         (foreach x  poi-txt
          (if (equal (cadr (car x)) (cadr (car (last poi-txt))) hei)
           (setq first-row (cons (car x) first-row)
                 first-row (vl-sort first-row '(lambda (x y) (< (car x) (car y)))))))
         (setq first-row (cons (polar (last first-row) (* pi 0) (+ max-wid (* hei 2))) first-row))
         ;; Dat bang vi tri moi
         (defun make_text  (/ lst-make p-org poi poi-x poi-j poi-new first-new)
          (if (setq poi (getpoint "\nDiem chen bang: "))
           (progn (repeat (setq i (sslength ss))
                   (setq lst-make (cons (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330 410))) (entget (ssname ss (setq i (1- i)))))
                                        lst-make)))
                  (setq p-org (car (vl-sort first-row '(lambda (x y) (< (car x) (car y))))))
                  (foreach x  lst-make
                   (setq poi-x (polar (cdr (assoc 10 x)) (angle p-org poi) (distance p-org poi))
                         poi-j (polar (cdr (assoc 11 x)) (angle p-org poi) (distance p-org poi)))
                   (setq x (subst (cons 10 poi-x) (assoc 10 x) x))
                   (setq x (subst (cons 11 poi-j) (assoc 11 x) x))
                   (entmakex x))
                  (foreach x  first-row
                   (setq poi-new   (polar x (angle p-org poi) (distance p-org poi))
                         first-new (cons poi-new first-new)))
                  (setq first-row first-new))))
         (make_text)
         ;; Ke bang
         (setq dis (/ (distance (car (car last-col)) (car (last last-col))) (1- (length last-col))))
         (foreach x  first-row
          (setq p1 (polar (polar x (* pi 1.0) hei) (* pi 0.5) (* 0.75 dis))) ;hei 1.5
          (setq p2 (polar p1 (* pi 1.5) (* dis (length last-col)))) ;2 hei
          (setq lst-p1 (cons p1 lst-p1)
                lst-p2 (cons p2 lst-p2))
          (Make_line p1 p2))
         (setq lst-p1 (vl-sort lst-p1 '(lambda (x y) (< (car x) (car y)))))
         (setq i 0)
         (repeat (+ (length last-col) 1)
          (setq p1 (polar (car lst-p1) (* pi 1.5) (* dis i)) ;2 hei
                p2 (polar (last lst-p1) (* pi 1.5) (* dis i))) ;2 hei
          (Make_line p1 p2)
          (setq i (1+ i)))
         (setvar "TEXTSTYLE" old-sty)))
 (princ))​

+ Số cột phụ thuộc vào hàng đầu tiên.

+ Các hàng phải có khoảng cách đều.

Mình đang nghiên cứu viết cho AutocadTable, sẽ khắc phục được các vấn đề trên.

Cảm ơn anh rất nhiều nhé! anh nhiệt tình quá, hehe, hy vọng và chờ đợi anh nghiên cứu thành công AutocadTable! :)

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

Bạn tải file này về và lệnh do bạn đặt tùy ý theo 2  cách như sau:

http://www.cadviet.com/upfiles/5/141736_text2autocadtable.rar

1. C1: Tạo 1 file lisp (hoặc chép vào 1 file lsp nào đó của bạn mà autoload) có nội dung như sau:

(defun c:TENLENH () (Text-2-AutocadTable) )

*** Cách này thì bạn phải load cả 2 file gồm file lsp vừa tạo và file .fas ở trên.

2. C2:

+ Chép file fas ở trên vào trong thư mục có hỗ trợ cho CAD.

+ Nội dung cần tạo trong file lsp:

(if (findfile "Text-2-AutocadTable.fas")(load "Text-2-AutocadTable.fas"))

(defun c:TENLENH () (Text-2-AutocadTable) )

*** Cách này không cần phải load file .fas

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

Bạn tải file này về và lệnh do bạn đặt tùy ý theo 2  cách như sau:

http://www.cadviet.com/upfiles/5/141736_text2autocadtable.rar

1. C1: Tạo 1 file lisp (hoặc chép vào 1 file lsp nào đó của bạn mà autoload) có nội dung như sau:

(defun c:TENLENH () (Text-2-AutocadTable) )

*** Cách này thì bạn phải load cả 2 file gồm file lsp vừa tạo và file .fas ở trên.

2. C2:

+ Chép file fas ở trên vào trong thư mục có hỗ trợ cho CAD.

+ Nội dung cần tạo trong file lsp:

(if (findfile "Text-2-AutocadTable.fas")(load "Text-2-AutocadTable.fas"))

(defun c:TENLENH () (Text-2-AutocadTable) )

*** Cách này không cần phải load file .fas

Cảm ơn anh nhiều nhé! Cho em hỏi thêm là cách này có dùng được cho file VLX không. Em muốn đổi tên lệnh file ABC(.VLX) thành CDE mà khi đánh lệnh ABC thì lisp sẽ không chạy. Do tên lệnh trùng với các lệnh khác nên em muốn đổi, anh có cách nào chỉ em với nhé!

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

Không giống như bạn nghĩ đâu!

1. Hướng dẫn ở trên là do mình đặt tên file và hàm trong file đó giống nhau.

2. Bạn có thể thay đổi tên file tùy ý, nhưng tên hàm thì không (tức là: Text-2-AutocadTable.fas ->Rename-> abcd.fas).

3.Trong file bạn gửi, có 2 lệnh CC và Vlconvert (cùng 1 chức năng), vì vậy có thể tạm xử lý như sau: (File khác thì không chắc nhé!)

+ Load file có lệnh (CC và Vlconvert) trước, load file có lệnh CC (chức năng gì đó) của bạn sau -> Lúc này trong máy của bạn tồn tại 2 lệnh Vlconvert và CC có chức năng khác nhau (CC sau đè CC trước).

+ Load 1 file lisp có nội dung: (defun C:DFF () (C:Vlconvert)).

Như vậy là OK.

P/S: Nhớ là phải đúng thứ tự như hướng dẫn, có thể gộp lại trong 1 file lisp theo Hd ở bài trướ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

Không giống như bạn nghĩ đâu!

1. Hướng dẫn ở trên là do mình đặt tên file và hàm trong file đó giống nhau.

2. Bạn có thể thay đổi tên file tùy ý, nhưng tên hàm thì không (tức là: Text-2-AutocadTable.fas ->Rename-> abcd.fas).

3.Trong file bạn gửi, có 2 lệnh CC và Vlconvert (cùng 1 chức năng), vì vậy có thể tạm xử lý như sau: (File khác thì không chắc nhé!)

+ Load file có lệnh (CC và Vlconvert) trước, load file có lệnh CC (chức năng gì đó) của bạn sau -> Lúc này trong máy của bạn tồn tại 2 lệnh Vlconvert và CC có chức năng khác nhau (CC sau đè CC trước).

+ Load 1 file lisp có nội dung: (defun C:DFF () (C:Vlconvert)).

Như vậy là OK.

P/S: Nhớ là phải đúng thứ tự như hướng dẫn, có thể gộp lại trong 1 file lisp theo Hd ở bài trước.

Cảm ơn anh! Lệnh CC của em là sửa lại lệnh tắt của lệnh copy co trong cad anh ơi, em sử dụng CC quen cho việc copy rồi nên làm theo cách này cũng không đượ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

Không giống như bạn nghĩ đâu!

1. Hướng dẫn ở trên là do mình đặt tên file và hàm trong file đó giống nhau.

2. Bạn có thể thay đổi tên file tùy ý, nhưng tên hàm thì không (tức là: Text-2-AutocadTable.fas ->Rename-> abcd.fas).

3.Trong file bạn gửi, có 2 lệnh CC và Vlconvert (cùng 1 chức năng), vì vậy có thể tạm xử lý như sau: (File khác thì không chắc nhé!)

+ Load file có lệnh (CC và Vlconvert) trước, load file có lệnh CC (chức năng gì đó) của bạn sau -> Lúc này trong máy của bạn tồn tại 2 lệnh Vlconvert và CC có chức năng khác nhau (CC sau đè CC trước).

+ Load 1 file lisp có nội dung: (defun C:DFF () (C:Vlconvert)).

Như vậy là OK.

P/S: Nhớ là phải đúng thứ tự như hướng dẫn, có thể gộp lại trong 1 file lisp theo Hd ở bài trước.

Oke, em làm được rồi, cảm ơn anh đã quan tâm bài viết em nhé! chúc anh và diễn đàn luôn thành công và phát triể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

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  

×