Đến nội dung


Hình ảnh
* * * - - 1 Bình chọn

[Yêu cầu] viết lisp thống kê bản vẽ


  • Please log in to reply
177 replies to this topic

#81 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 23 March 2010 - 04:38 PM

- Về cột Filename : thông thuờng trong khung tên đã có 1 Tag tuơng tự như DrawingName hay TenBanVe. Theo dự đoán của tui, cột mà Phiphi cần là Filename có HyperLink (khi cần có thể click vào để Open file) nhưng hiên nay CAD chưa hỗ trợ HyperLink cho từng cell trong đối tuợng Table. Do đó LISP không thể tạo HyperLink đuợc.
- nút ADD ALL : có thể khắc phục bằng cách chọn Tag đầu tiên – nhấn và giữ phím Shift – chọn Tag cuối cùng – click vô ADD hoặc đơn giản hơn là dùng chụôt quét chọn toàn bộ Tag rồi click vô ADD.

Khung tên b/v PP đang làm là dùng nhiều attributes khác nhau để chỉ định ra 1 tên bản vẽ. Nó có dạng như sau:
"TYPE" "NAME" "DISCIPLINE" "AREA" "SUB_AREA" "ZONING" "DOCUMENT_NO" "REVISION" "VERSION" (thí dụ = SK-PBB-PW-4-B-400-1001-E-01)
Vì vậy trong Excel phải dùng formula =IF(H2="","",B2&"-"&C2&"-"&D2&"-"&E2&"-"&F2&"-"&G2&"-"&H2&"-"&I2&"-"&J2)
Như vậy việc dùng 1 Tag để chỉ định ra DrawingName hay TenBanVe như Gia-Bach nghĩ chỉ là 1 trường hợp mà thôi.
Còn việc tạo thành 1 Hyperlink thì có thể dùng VBA trong Excel thực hiện, công thức như sau:
file:/// + đuòng dẩn + filename thí dụ file:///C:\Test\SK-PBB-PW-4-B-400-1001-E-01.dwg hoặc file:///C:\Test\SK-PBB-PW-4-B-400-1001-E-01.pdf
PP đang dùng LISP của Lee đã post cho việc làm các Drawing lists và Hyperlinks.
  • 0

#82 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 23 March 2010 - 05:42 PM

- Về cột Filename : thông thuờng trong khung tên đã có 1 Tag tuơng tự như DrawingName hay TenBanVe. Theo dự đoán của tui, cột mà Phiphi cần là Filename có HyperLink (khi cần có thể click vào để Open file) nhưng hiên nay CAD chưa hỗ trợ HyperLink cho từng cell trong đối tuợng Table. Do đó LISP không thể tạo HyperLink đuợc.

lisp có thể tạo được Hyperlink anh ạ. Nó nằm ở Xdata của đối tượng.

- khả năng tự update : hiên nay CAD chưa hỗ trợ LinkField cho từng thuộc tính (attribute) trong đối tuợng block attribute. Do đó LISP không có khả năng tự Update.

Field vẫn có thể dùng với Attb bình thường mà anh. Nhưng theo ý em nên dùng Reactor cho trường hợp này là hay nhất vì: Nó có thể tự động update, thứ 2 là nó là dạng 2 chiều (thằng mục lục đổi thì thằng bản vẽ đổi và ngược lại). Tuy nhiên cần phải chú ý là Reactor chỉ có tác dụng khi App lisp. Nếu không có lisp thì nó lại trơ ra như đá. Dùng bảng thống kê bằng Table khá tiện nhưng để đưa một số tính năng Hyperlink và Reactor vào thì theo em ta nên chuyển thành các block thuộc tính.

Kết luận: với những tính năng bổ sung em vừa nói thì hoàn toàn có thể phát triển lisp của anh thêm 1 bước nữa. Ngoài việc tạo được một sản phẩm có ích thì nó cũng cho ta nâng thêm 1 tầm mới trong hành trình chinh phục lisp anh nhẩy :D
  • 2

#83 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 24 March 2010 - 07:56 AM

lisp có thể tạo được Hyperlink anh ạ. Nó nằm ở Xdata của đối tượng.

Field vẫn có thể dùng với Attb bình thường mà anh. Nhưng theo ý em nên dùng Reactor cho trường hợp này là hay nhất vì: Nó có thể tự động update, thứ 2 là nó là dạng 2 chiều (thằng mục lục đổi thì thằng bản vẽ đổi và ngược lại). Tuy nhiên cần phải chú ý là Reactor chỉ có tác dụng khi App lisp. Nếu không có lisp thì nó lại trơ ra như đá. Dùng bảng thống kê bằng Table khá tiện nhưng để đưa một số tính năng Hyperlink và Reactor vào thì theo em ta nên chuyển thành các block thuộc tính.

Kết luận: với những tính năng bổ sung em vừa nói thì hoàn toàn có thể phát triển lisp của anh thêm 1 bước nữa. Ngoài việc tạo được một sản phẩm có ích thì nó cũng cho ta nâng thêm 1 tầm mới trong hành trình chinh phục lisp anh nhẩy :D

lisp (chính xác là VLisp) có thể tạo được Hyperlink, nhưng HyperLink cho từng cell trong đối tuợng Table thì chưa.

Trong truờng hợp này là Field với Block Attribute (không phải Attb).
Nếu có thể, Bạn cho 1 ví dụ về : Field với Block Attribute.
Cám ơn nhiều.
  • 2

#84 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 24 March 2010 - 09:34 AM

lisp (chính xác là VLisp) có thể tạo được Hyperlink, nhưng HyperLink cho từng cell trong đối tuợng Table thì chưa.

Trong truờng hợp này là Field với Block Attribute (không phải Attb).
Nếu có thể, Bạn cho 1 ví dụ về : Field với Block Attribute.
Cám ơn nhiều.


Điều ngạc nhiên là một lập trình viên cỡ như gia_bach lại thắc mắc về Field Block Attribute (BA)
Sử dụng Field trong BA có nhiều cái hay

gia_bach xem clip tôi tạo nhé biết đâu you sẽ phát hiện ra cách update cho table thì sao?
Toa do
  • 0

#85 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 24 March 2010 - 09:54 PM

lisp (chính xác là VLisp) có thể tạo được Hyperlink, nhưng HyperLink cho từng cell trong đối tuợng Table thì chưa.

Trong truờng hợp này là Field với Block Attribute (không phải Attb).
Nếu có thể, Bạn cho 1 ví dụ về : Field với Block Attribute.
Cám ơn nhiều.

Hiện tại em đang bận chiến đấu ở chiến trường, không có ở cty. Khi nào về cty em sẽ thử lấy 1 vài ví dụ.
  • 0

#86 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 24 March 2010 - 11:21 PM

Hiện tại em đang bận chiến đấu ở chiến trường, không có ở cty. Khi nào về cty em sẽ thử lấy 1 vài ví dụ.

Chúc chiến hữu Nataca luôn dồi dào sức khoẻ để chiến đấu thật tốt ở chiến trường. Và sau đó cùng anh em sát cánh trong công cuộc phát triển diễn đàn. Rất mong những ví dụ thật có ích của Chiến hữu
Ở chiến trường nhớ giữ gìn sức khoẻ.
Mời chiến hữu 1 ly cho ấm tình đồng đội :D
  • 1

#87 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 23 April 2010 - 07:36 AM

Chúc chiến hữu Nataca luôn dồi dào sức khoẻ để chiến đấu thật tốt ở chiến trường. Và sau đó cùng anh em sát cánh trong công cuộc phát triển diễn đàn. Rất mong những ví dụ thật có ích của Chiến hữu
Ở chiến trường nhớ giữ gìn sức khoẻ.
Mời chiến hữu 1 ly cho ấm tình đồng đội :undecided:

Chiến trường đã tan, em trở về với việc nhà bề bộn. Xin lỗi bác vì chưa trả lời được bác sớm.
Đây là đoạn Code ví dụ về Link giữa 2 thuộc tính của Block (lấy chính từ lisp này)

(defun C:LGT (/ obn Tkq)
(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
obd (vlax-ename->vla-object (car (nentsel "\nChon text dich")))
Tkq (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid obn) 2 0)
">%).TextString>%"
)
)
(vla-put-textstring obd Tkq)
(vla-update obd)
(vl-cmdf "regen")
(princ)
)


Hình đã gửi

Nhưng theo em nghĩ dùng chiêu này lợi hại hơn:

(defun C:RGT	(/ Lst obj_reactor)		;;;REACTOR GIA TRI voi TEXT
(setq Lst (C_S2LV (ES_ENTU "\nQuet chon cac TEXT can LINK REACTOR gia tri..." "*TEXT"))
obj_reactor (vlr-object-reactor Lst "Reactor Gia tri" '((:vlr-modified . CALLBACK_STRINGTEXT)))
)
(if (null (vlr-pers-p obj_reactor))
(vlr-pers obj_reactor)
)
(defun CALLBACK_STRINGTEXT (dtthaydoi reactor Lstmorong / objlist newt erase)
(if (not-unwind)
(progn
(setq objlist (vlr-owners reactor))
(if (null (vlax-erased-p dtthaydoi))
(progn
(setq newt (vla-get-textstring dtthaydoi))
(foreach obj objlist
(if (/= (vla-get-textstring obj) newt)
(vla-put-textstring obj newt)
)
)
)
(progn
(alert "Doi tuong co link Reactor!!!")
)
)
)
)
)
(defun ES_ENTU (dongnhac Nent / ss LNent Lst SLst)

(if (= Nent nil)
(while (and (not (prompt dongnhac))
(not (or (setq ss (ssget "I"))
(setq ss (ssget))
)
)
)
)
(while (and (not (prompt dongnhac))
(not (or (setq ss (ssget "I" (list (cons 0 Nent))))
(setq ss (ssget (list (cons 0 Nent))))
)
)
)
)
)
ss
)
(defun not-unwind ()
(not (wcmatch (getvar "cmdnames") "U,UNDO,REDO,OOPS,QSAVE"))
)
(defun C_S2LV (ss)
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
)

  • 2

#88 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 April 2010 - 10:34 AM

Chiến trường đã tan, em trở về với việc nhà bề bộn. Xin lỗi bác vì chưa trả lời được bác sớm.
............
Nhưng theo em nghĩ dùng chiêu này lợi hại hơn:

(defun C:RGT	(/ Lst obj_reactor)		;;;REACTOR GIA TRI voi TEXT
(setq Lst (C_S2LV (ES_ENTU "\nQuet chon cac TEXT can LINK REACTOR gia tri..." "*TEXT"))
obj_reactor (vlr-object-reactor Lst "Reactor Gia tri" '((:vlr-modified . CALLBACK_STRINGTEXT)))
)
(if (null (vlr-pers-p obj_reactor))
(vlr-pers obj_reactor)
)
(defun CALLBACK_STRINGTEXT (dtthaydoi reactor Lstmorong / objlist newt erase)
(if (not-unwind)
(progn
(setq objlist (vlr-owners reactor))
(if (null (vlax-erased-p dtthaydoi))
(progn
(setq newt (vla-get-textstring dtthaydoi))
(foreach obj objlist
(if (/= (vla-get-textstring obj) newt)
(vla-put-textstring obj newt)
)
)
)
(progn
(alert "Doi tuong co link Reactor!!!")
)
)
)
)
)
(defun ES_ENTU (dongnhac Nent / ss LNent Lst SLst)

(if (= Nent nil)
(while (and (not (prompt dongnhac))
(not (or (setq ss (ssget "I"))
(setq ss (ssget))
)
)
)
)
(while (and (not (prompt dongnhac))
(not (or (setq ss (ssget "I" (list (cons 0 Nent))))
(setq ss (ssget (list (cons 0 Nent))))
)
)
)
)
)
ss
)
(defun C_S2LV (ss)
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
)

Chào Nataca
Trong hàm con CALLBACK_STRINGTEXT không có hàm nào mang tên
(not-unwind) -> ; error: no function definition: NOT-UNWIND
Nhờ Nataca kiểm tra lại Lisp RGT dùm chút. Cảm ơn Nataca
  • 0

#89 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 24 April 2010 - 01:58 PM

Chào Nataca
Trong hàm con CALLBACK_STRINGTEXT không có hàm nào mang tên
(not-unwind) -> ; error: no function definition: NOT-UNWIND
Nhờ Nataca kiểm tra lại Lisp RGT dùm chút. Cảm ơn Nataca

Do em thiếu hàm Unwind anh ạ. Anh có thể bỏ hàm này đi cũng ko sao (sửa Code 1 tý)
Em đã thêm đầy đủ hàm vào rồi. Anh kiểm tra lại xem nhé
  • 1

#90 quan_elec

quan_elec

    biết zoom

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

Đã gửi 14 May 2010 - 04:39 PM

Để Tue_NV giúp anh gia_bach một tay nhé :
Các bạn chạy lại code thử và góp ý nhé :


(defun c:draw_name (/ att doc i kyhieu lst lstatt msp pt row ss tblobj ten) ;Bang ten ban ve
;; By : Gia Bach, Copyright- December 2009 ;;
;; Contact : gia_bach @ www.CadViet.com ;;
(defun VxGetAtts (Obj)
(mapcar
'(lambda (Att)
(cons (vla-get-TagString Att)
(vla-get-TextString Att) ) )
(vlax-invoke Obj 'GetAttributes) ))
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn

(if (setq ss (ssget "_A"(list (cons 0 "INSERT")(cons 66 1)(cons 2 "KHUNG CHUAN SEICO"))))
(progn
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
msp (vla-get-modelspace doc))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq lstAtt (VxGetAtts (vlax-ename->vla-object e))
kyhieu (cdr (assoc "DWNNO" lstAtt))
ten (cdr (assoc "DRAWING1" lstAtt)))
(setq lst (cons (cons kyhieu ten) lst)) )
(setq lst (vl-sort lst '(lambda (x y) (< (atoi(substr (car x) 4 (- (strlen (car x)) 3)))
(atoi (substr (car y) 4 (- (strlen (car y)) 3)))
) ) ))
(setq i 1
row 2
pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 15 100))
(vla-put-vertcellmargin TblObj 4)
(vla-SetColumnWidth TblObj 0 50)
(mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
(list acTitleRow acHeaderRow acDataRow))
(vla-setText TblObj 0 0 "list of drawings")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Ten ban e")
(vla-setText TblObj 1 2 "Ky hieu")
(foreach pt lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (cdr pt))
(vla-setText TblObj row 2 (car pt))
(setq row (1+ row) i (1+ i))
)
(vlax-release-object TblObj)
(princ lst) ) ) )
(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
))

@anh gia_bach : Hàm vl-sort nó sắp xếp các kí tự chuỗi theo alphabet.
Ví dụ như List :
(setq L (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "98" "99" "100"))

khi sử dụng vl-sort nó sắp xếp các kí tự chuỗi theo alphabet.
=> Kết quả sẽ trả về như thế này thì không theo ý của User
("1" "10" "100" "11" "12" "2" "3" "4" "5" "6" "7" "8" "9" "98" "99")
-> Nó ưu tiên sắp xếp kí tự "1.." trước mà anh

Nhưng khi ta set nó về số thì sẽ đúng theo ý User
.Ví dụ :
(setq L (list 1 2 3 4 5 6 7 8 9 10 11 12 99 100))
(vl-sort L '<)
(1 2 3 4 5 6 7 8 9 10 11 12 99 100)
thì khi sử dụng vl-sort theo ý của mình nên em đã sử dụng hàm atoi để chuyển chuõi kí tự về dạng số rồi so sánh chúng với nhau để theo ý của mình

Anh gia_bach cho Tue_NV hỏi thêm về chổ này một chút :
(mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
(list acTitleRow acHeaderRow acDataRow))


4 mã code này em chưa rõ ý nghĩa của nó lắm. Anh có thể giải thích dùm em 1 chút nhé.
Cảm ơn anh


-Cám ơn bác gia_bach và Tue_NV , mình đã download Lisp này và "xào , nấu " lại cho khung tên của công ty mình .Kết quả là việc thống kê rất nhanh chóng . Tuy nhiên
có phần vẫn hơi vướng :
+ Đối với những tên bản vẽ dài phải sử dụng 2 text mới thể hiện đủ tên bản vẽ thì lisp này không thể hiện được text thứ 2 .
- Để thể hiện được cả 2 text này thì phải làm sao ? 2 bác giúp em với nhé . (Do căn bản Lisp không có nên mò mẫm mấy buổi trời vẫn không ra , HIX) .
- Sẵn đây hỏi các bác chỗ dạy Autolisp trong Saigon luôn , bác nào có chỗ dạy hay chỉ em với nhé . Thanks . :cheers:
  • 0

#91 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 May 2010 - 08:33 PM

-Cám ơn bác gia_bach và Tue_NV , mình đã download Lisp này và "xào , nấu " lại cho khung tên của công ty mình .Kết quả là việc thống kê rất nhanh chóng . Tuy nhiên
có phần vẫn hơi vướng :
+ Đối với những tên bản vẽ dài phải sử dụng 2 text mới thể hiện đủ tên bản vẽ thì lisp này không thể hiện được text thứ 2 .
- Để thể hiện được cả 2 text này thì phải làm sao ? 2 bác giúp em với nhé . (Do căn bản Lisp không có nên mò mẫm mấy buổi trời vẫn không ra , HIX) .
- Sẵn đây hỏi các bác chỗ dạy Autolisp trong Saigon luôn , bác nào có chỗ dạy hay chỉ em với nhé . Thanks . :cheers:

Với CAD2008 trở lên : Khi sử dung lệnh Att để tạo thuộc tính cho Block -> Hãy chọn Multiple Lines , mục Mode trong hộp thoại Attribute Denifition
--->>>>> Bạn có thể viết bao nhiêu hàng tuỳ thích. Lisp thể hiện được luôn. Bạn thử nhé
  • 0

#92 quan_elec

quan_elec

    biết zoom

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

Đã gửi 17 May 2010 - 09:03 AM

Với CAD2008 trở lên : Khi sử dung lệnh Att để tạo thuộc tính cho Block -> Hãy chọn Multiple Lines , mục Mode trong hộp thoại Attribute Denifition
--->>>>> Bạn có thể viết bao nhiêu hàng tuỳ thích. Lisp thể hiện được luôn. Bạn thử nhé


Hay quá , đã làm được rồi bác Tue_NV . Cám ơn bác và Cadviet nhiều . Bác có ở Sàigòn cho tui tầm sư học đạo với . Cám ơn bác nhiều nhé .Hy vọng sẽ lại làm phiền bác . :cheers:
  • 0

#93 duonghung1210

duonghung1210

    biết lệnh offset

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

Đã gửi 17 May 2010 - 10:32 AM

Bỗng dưng lish thống kê không sử dụng được, lúc mới dowload về thì chạy ngon, nhưng sau một thời gian bây giờ dùng thì "chết"
đã dowload lại và dùng với bản cad khác trong công ty nhưng cũng thế?? sao vậy nhỉ??
Command: ap
APPLOAD ExtBlkAtt.VLX successfully loaded.


Command:
Go lenh exBlk de bat dau.
Command:
Command: exblk

Cụ thể, lúc load thì và gõ lệnh thì bình thường nhưng khi lên hộp thoại và tích vao thẻ tạo bảng thì không thấy gì nữa, bác nào biết nguyên nhân chỉ giúp em cái! em cảm ơn! :cheers: :cheers:
  • 0
Nhăn răng ra cười cho đời đỡ khổ!!!

#94 quan_elec

quan_elec

    biết zoom

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

Đã gửi 18 May 2010 - 02:25 PM

Với CAD2008 trở lên : Khi sử dung lệnh Att để tạo thuộc tính cho Block -> Hãy chọn Multiple Lines , mục Mode trong hộp thoại Attribute Denifition
--->>>>> Bạn có thể viết bao nhiêu hàng tuỳ thích. Lisp thể hiện được luôn. Bạn thử nhé


Lại phải làm phiền bác Tue_NV nữa rồi , mong bác giúp đỡ . Bảng liệt kê danh sách bản vẽ tự động khi đánh tiếng Việt thì xuất ra bị lỗi Font , mặc dù đã chỉnh TextStype . chuyển Font ... vẫn không ăn thua , Mong bác Tue_NV giúp mình lần nữa . Cám ơn bác .
đây là link bản vẽ của tui : http://www.mediafire.com/?it3gghmvqjo
  • 0

#95 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 May 2010 - 04:13 PM

Lại phải làm phiền bác Tue_NV nữa rồi , mong bác giúp đỡ . Bảng liệt kê danh sách bản vẽ tự động khi đánh tiếng Việt thì xuất ra bị lỗi Font , mặc dù đã chỉnh TextStype . chuyển Font ... vẫn không ăn thua , Mong bác Tue_NV giúp mình lần nữa . Cám ơn bác .
đây là link bản vẽ của tui : http://www.mediafire.com/?it3gghmvqjo

Nếu sử dụng hàm Vxgetatt của anh gia_bach sẽ bị lỗi Font Unicode. Anh gia_bach xem lại code của anh 1 tý.
Đây là code mà Tue_NV viết lại -> quan_elec' chạy thử nhé :
Chạy với file mà file của bạn đã upload lên đây. Chú ý chọn Font chữ hiện hành giống với font chữ trong Khung tên
Đó là Style : KHUNGTEN-TIEUDE (font chữ Aria -Bảng mã Unicode)
Bạn chạy thử với code sau -> Tue_NV đã chỉnh lại :

(defun c:draw_name (/ att doc i kyhieu lst lstatt msp pt row ss tblobj ten) ;Bang ten ban ve
;; By : Gia Bach, Copyright- December 2009 ;;
;; Contact : gia_bach @ www.CadViet.com ;;
;Develop by Tue_NV. Contact : @tue_nvcc@yahoo.com
(defun VxGetAtts (Obj / L)
(setq L '())
(while (not (= (cdr(assoc 0 (entget (setq e (entnext e))
))) "SEQEND"))
(setq L (append L (list (list (cdr(assoc 2 (entget e)))
(cdr(assoc 1 (entget e)))
)
)
)
)
)
);defun
(SETQ lst '())
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn

(if (setq ss (ssget "_A"(list (cons 0 "INSERT")(cons 66 1)(cons 2 "KT"))))
(progn
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
msp (vla-get-modelspace doc))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq lstAtt (VxGetAtts e)
kyhieu (cadr (assoc "DWNNO" lstAtt))
ten (cdr (assoc "DRAWING" lstAtt)))
(setq lst (cons (cons kyhieu ten) lst)) )
(setq lst (vl-sort lst '(lambda (x y) (< (atoi(substr (car x) 4 (- (strlen (car x)) 3)))
(atoi (substr (car y) 4 (- (strlen (car y)) 3)))
) ) ))
(setq i 1
row 2
pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 15 100))
(vla-put-vertcellmargin TblObj 4)
(vla-SetColumnWidth TblObj 0 50)
(mapcar '(lambda (x)(vla-SetTextStyle TblObj x (getvar "TEXTSTYLE")))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
(list acTitleRow acHeaderRow acDataRow))
(vla-setText TblObj 0 0 "list of drawings")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Ten ban Ve")
(vla-setText TblObj 1 2 "Ky hieu")
(foreach pt lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (cadr pt))
(vla-setText TblObj row 2 (car pt))
(setq row (1+ row) i (1+ i))
)
(vlax-release-object TblObj)
(princ lst) ) ) )
(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
))


Bỗng dưng lish thống kê không sử dụng được, lúc mới dowload về thì chạy ngon, nhưng sau một thời gian bây giờ dùng thì "chết"
đã dowload lại và dùng với bản cad khác trong công ty nhưng cũng thế?? sao vậy nhỉ??
Command: ap
APPLOAD ExtBlkAtt.VLX successfully loaded.
Command:
Go lenh exBlk de bat dau.
Command:
Command: exblk

Cụ thể, lúc load thì và gõ lệnh thì bình thường nhưng khi lên hộp thoại và tích vao thẻ tạo bảng thì không thấy gì nữa, bác nào biết nguyên nhân chỉ giúp em cái! em cảm ơn! :cry: :cheers:

Đúng là nó tự dưng "chết" thiệt. :cheers: Chẳng hiểu nguyên nhân. Chỉ có anh gia_bach mới giải thích được cái này :cry:
  • 2

#96 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 19 May 2010 - 08:18 AM

Cập nhật Block Attributes Extraction Version 1.0
Bổ sung :
- tạo Link Field trong Bảng thống kê.
- nút Move DownMove Up: di chuyển thứ tự các TAG.
Hình đã gửi

Update : bài viết 114

Bài viết đã được chỉnh sửa nội dung bởi gia_bach: 21 May 2010 - 01:04 PM

  • 1

#97 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 May 2010 - 08:25 AM

Cập nhật Block Attributes Extraction Version 1.0
Bổ sung :
- tạo Link Field trong Bảng thống kê.
- nút Move DownMove Up: di chuyển thứ tự các TAG.
Hình đã gửi
DownLoad Here

Chào anh gia_bach. Code bị lỗi
Lỗi :
** Error: no function definition: MAKE_LIST **
Không có hàm MAKE_LIST
  • 1

#98 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 19 May 2010 - 10:54 AM

Chào anh gia_bach. Code bị lỗi
Lỗi :
** Error: no function definition: MAKE_LIST **
Không có hàm MAKE_LIST

Cám ơn Tue_NV nhiều.
Update, vui lòng lấy Link tại bài trên.
  • 1

#99 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 19 May 2010 - 11:23 AM

Cám ơn Tue_NV nhiều.
Update, vui lòng lấy Link tại bài trên.

Đã test code.
Tuy nhiên, khi TagVal của Att có nhiều dòng thì xuất hiện dấu \P : thể hiện sự ngăn cách các dòng.
Ví dụ :
MẶT BẰNG BỐ TRÍ CHIẾU SÁNG
TẦNG 1
Khi chạy Lisp bảng xuất hiện sẽ là :
MẶT BẰNG BỐ TRÍ CHIẾU SÁNG\PTẦNG 1

anh gia bach nên thay thế dấu \P thành khoảng trắng thì sẽ hợp lý hơn.

Anh cho em hỏi về cách Link field giá trị thuộc tính của Block vào Table được không? Một ví dụ nhỏ nhỏ cũng được. Cảm ơn anh.
  • 1

#100 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 19 May 2010 - 01:49 PM

Đã test code.
Tuy nhiên, khi TagVal của Att có nhiều dòng thì xuất hiện dấu \P : thể hiện sự ngăn cách các dòng.
Ví dụ :
MẶT BẰNG BỐ TRÍ CHIẾU SÁNG
TẦNG 1
Khi chạy Lisp bảng xuất hiện sẽ là :
MẶT BẰNG BỐ TRÍ CHIẾU SÁNG\PTẦNG 1

anh gia bach nên thay thế dấu \P thành khoảng trắng thì sẽ hợp lý hơn.

Anh cho em hỏi về cách Link field giá trị thuộc tính của Block vào Table được không? Một ví dụ nhỏ nhỏ cũng được. Cảm ơn anh.

Chào Tue_NV
Anh đã phát hiện lỗi này khi Test, nhưng việc xử lý dấu \P (kí tự xuống dòng) trong LINK FIELD anh chưa biết cách. <_<
Nếu không phải LINK FIELD thì có thể giải quyết đuợc. (xử lý chuỗi [String] thì đơn giản hơn.)

Gửi em code cách Link field giá trị thuộc tính của Block vào Table
(defun c:Blk (/ AttLst col field h j msp obj pt ss TblObj)
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)
(princ "\nChon Block thuoc tinh:" )
(if (setq ss (ssget "+.:S:N" (list (cons 0 "INSERT")(cons 66 1))))
(progn
(setq obj (vlax-Ename->Vla-Object(ssname ss 0)))
(foreach Att (append (vlax-invoke Obj 'GetAttributes)
(vlax-invoke Obj 'GetConstantAttributes))
(setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid Att)) ">%).TextString>%")
AttLst (cons (cons (vla-get-TagString Att) field) AttLst)) )
(setq msp (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
h (* (getvar "dimtxt")(getvar "dimscale"))
col (length AttLst))
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) 3 col (* 2 h) (* 15 h)))
(vla-put-vertcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
(list acTitleRow acHeaderRow acDataRow) )
(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
(list acTitleRow acHeaderRow acDataRow))
(vla-MergeCells TblObj 0 0 0 (- col 1))
(vla-setText TblObj 0 0 (vla-get-Name obj))
(setq j 0)
(foreach pt AttLst
(vla-setText TblObj 1 j (car pt))
(vla-setText TblObj 2 j (cdr pt))
(setq j (1+ j)) )
(vlax-release-object TblObj))
(alert "\nKhong phai Block thuoc tinh:" ))
(princ))

  • 2