Chương trình thống kê vật tư

[ainhandilac 5]

tôi muốn viết chương trình copy text từ acad vào bảng excel để thống kê vật tư, trong đó sử dụng ssget để lựa chọn ( tôi muốn chọn text theo khung windowns), nhưng ko chạy được, nhờ các bro hiệu chỉnh dùm nhé, xin cảm ơn nhiều:

 

(defun c:vt ()

(setq fn (getfiled "select a file to write text" "" "xls" 1))

(if (null fn)

(princ "no file selected!")

(progn

(while

;************************************************

 

(setq A (ssget '(0 . "text")))

(setq n 1)

 

(setq t1 (assoc (Nth 1 A)))

(setq n (+ 1 n))

(ghi)

 

)

)

)

)

;*****************************************

(defun ghi ()

(setq pw (open fn "a"))

(write-line t1 pw)

(close pw)

)

[vndesperados 254]

tôi muốn viết chương trình copy text từ acad vào bảng excel để thống kê vật tư, trong đó sử dụng ssget để lựa chọn ( tôi muốn chọn text theo khung windowns), nhưng ko chạy được, nhờ các bro hiệu chỉnh dùm nhé, xin cảm ơn nhiều:

 

(defun c:vt ()

(setq fn (getfiled "select a file to write text" "" "xls" 1))

(if (null fn)

(princ "no file selected!")

(progn

(while

;************************************************

 

(setq A (ssget '(0 . "text")))

(setq n 1)

 

(setq t1 (assoc (Nth 1 A)))

(setq n (+ 1 n))

(ghi)

 

)

)

)

)

;*****************************************

(defun ghi ()

(setq pw (open fn "a"))

(write-line t1 pw)

(close pw)

)

 

 

Bó tay bác này luôn, bác ghi vào file *.xls theo chuẩn *.txt

Cái này trên đây mọi người nói nhiều lắm rồi

Bác chịu khó search đi nhé, thế nào cũng tìm ra giải pháp

Chúc thành công...

[ainhandilac 5]

Bó tay bác này luôn, bác ghi vào file *.xls theo chuẩn *.txt

Cái này trên đây mọi người nói nhiều lắm rồi

Bác chịu khó search đi nhé, thế nào cũng tìm ra giải pháp

Chúc thành công...

 

thank anyway!

nhưng mà

ghi vào xls và vao txt thì có vấn đề gì cơ chứ, mấy chương trình của tôi vẫn ghi vào xls bình thường đấy thôi, có lỗi đâu. Tôi muốn các bro hiệu chỉnh và hướng dẫn giúp tôi phần tham số của lệnh ssget kìa đặc bi là phần lọc đối tượng là text và nội dung của nó

mong các bro nhiệt tình giúp đỡ nhé

[vndesperados 254]

tôi muốn viết chương trình copy text từ acad vào bảng excel để thống kê vật tư, trong đó sử dụng ssget để lựa chọn ( tôi muốn chọn text theo khung windowns), nhưng ko chạy được, nhờ các bro hiệu chỉnh dùm nhé, xin cảm ơn nhiều:

 

(defun c:vt ()

(setq fn (getfiled "select a file to write text" "" "xls" 1))

(if (null fn)

(princ "no file selected!")

(progn

(while

;************************************************

 

(setq A (ssget '(0 . "text")))

(setq n 1)

 

(setq t1 (assoc (Nth 1 A)))

(setq n (+ 1 n))

(ghi)

 

)

)

)

)

;*****************************************

(defun ghi ()

(setq pw (open fn "a"))

(write-line t1 pw)

(close pw)

)

 

 

 

 

(setq ss (Ssget '((0 . "TEXT"))))
(setq n (sslength ss))
(setq i 0)
(while  (i  (setq dt (ssname ss i))
 (setq t1 (assoc 1 (entget dt)))
 (GHI)
 (setq i (1+ i))
)

[ainhandilac 5]

(setq ss (Ssget '((0 . "TEXT"))))
(setq n (sslength ss))
(setq i 0)
(while  (i  (setq dt (ssname ss i))
 (setq t1 (assoc 1 (entget dt)))
 (GHI)
 (setq i (1+ i))
)

 

thank alot

hom nao di uong ca fe nhe bro!

[ainhandilac 5]

thank alot

hom nao di uong ca fe nhe bro!

 

ok tôi đã xong rồi đây, tặng các bro sản phẩm nhé

;copywrite ainhandilac

;Wase

(defun c:vt ()

(setq fn (getfiled "select a file to write text" "" "xls" 1))

(if (null fn)

(princ "no file selected!")

(progn

(setq ss (Ssget '((0 . "TEXT"))))

(setq n (sslength ss))

(setq i 0)

(while (< i n)

(setq dt (ssname ss i))

(setq t1 (cdr(assoc 1 (entget dt))))

(GHI)

(setq i (1+ i))

)

)

)

)

;*****************************************

(defun ghi ()

(setq pw (open fn "a"))

(write-line t1 pw)

(close pw)

)

[ssg 1.102]

ok tôi đã xong rồi đây, tặng các bro sản phẩm nhé

;copywrite ainhandilac

;Wase

(defun c:vt ()

(setq fn (getfiled "select a file to write text" "" "xls" 1))

(if (null fn)

(princ "no file selected!")

(progn

(setq ss (Ssget '((0 . "TEXT"))))

(setq n (sslength ss))

(setq i 0)

(while (< i n)

(setq dt (ssname ss i))

(setq t1 (cdr(assoc 1 (entget dt))))

(GHI)

(setq i (1+ i))

)

)

)

)

;*****************************************

(defun ghi ()

(setq pw (open fn "a"))

(write-line t1 pw)

(close pw)

)

 

Trình của bạn chạy tốt, nhưng Ssg xin góp ý ở góc nhìn của lập trình viên:

1) Không nên lập function ghi. Đối tượng ss sau khi chọn đã xác định hoàn toàn, lẽ ra chỉ nên open và close file 1 lần thôi. Cách làm của bạn làm chương trình chạy chậm, vì phải thao tác nhiều lần trên disk (do chương trình nhỏ nên có thể không nhận thấy)

2) Dùng thông báo alert gây ấn tượng và hiệu quả hơn princ

 

Bạn tham khảo đoạn sau và cho ý kiến:

 

(defun C:VT2( / fn f ss e t1)
(if (setq fn (getfiled "Select file" "" "xls" 1))
(progn	
	(setq f (open fn "a"))
	(setq ss (ssget '((0 . "TEXT"))))
	(while (setq e (ssname ss 0))
		(setq t1 (cdr (assoc 1 (entget e))))
		(write-line t1 f)
		(ssdel e ss)
	)
	(close f)
)
(alert "No file selected!")
)
)

[ainhandilac 5]

Trình của bạn chạy tốt, nhưng Ssg xin góp ý ở góc nhìn của lập trình viên:

1) Không nên lập function ghi. Đối tượng ss sau khi chọn đã xác định hoàn toàn, lẽ ra chỉ nên open và close file 1 lần thôi. Cách làm của bạn làm chương trình chạy chậm, vì phải thao tác nhiều lần trên disk (do chương trình nhỏ nên có thể không nhận thấy)

2) Dùng thông báo alert gây ấn tượng và hiệu quả hơn princ

 

Bạn tham khảo đoạn sau và cho ý kiến:

 

(defun C:VT2( / fn f ss e t1)
(if (setq fn (getfiled "Select file" "" "xls" 1))
(progn	
	(setq f (open fn "a"))
	(setq ss (ssget '((0 . "TEXT"))))
	(while (setq e (ssname ss 0))
		(setq t1 (cdr (assoc 1 (entget e))))
		(write-line t1 f)
		(ssdel e ss)
	)
	(close f)
)
(alert "No file selected!")
)
)

thank nhe!

Dung la pro co khac

hi vong duoc chi bao nhieu hon

[thangbkpro 0]

Cảm ơn bạn ainhandilac và SSG vì lip hữu ích trên. Lip này lùng cả tuần nay giờ mới search thấy :D. Nhưng các bạn có thể update thêm tính năng để thống kê text trong bản vẽ luôn được không.

Mình đang cần như sau:

1. Chuyển text sang exel. Một cột là giá trị text cột kia là số lượng text.

Mình tìm được lip như vậy của bạn gia_bach nhưng chỉ tạo bảng table trên cad. Chắc chỉ cần áp dụng thêm code này với code ở trên là được. Bạn nào giúp mình với nhé:

http://www.cadviet.com/forum/index.php?showtopic=14684

code:

(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); thong ke text

;; By : Gia Bach, Copyrightｩ December 2010 ;;

;; Contact : gia_bach @ www.CadViet.com ;;

(defun TxtWidth (val msp / txt minp maxp)

(vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)

(vla-Erase txt)

(-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) )

;main

(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)

(progn

(vl-load-com)

(princ "\nChon cac Text de thong ke :")

(if (setq ss (ssget(list (cons 0 "TEXT"))))

(progn

(setq i -1 len0 8)

(while (setq ent (ssname ss (setq i (1+ i))))

(setq str(cdr(assoc 1 (entget ent ))))

(if (> (setq str_len (strlen str)) len0)

(setq str0 str len0 str_len) )

(if (not (assoc str lst))

(setq lst (cons (cons str 1) lst))

(setq lst (subst (cons str (1+ (cdr (assoc str lst))))

(assoc str lst) lst))) )

(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))

msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

(or *h* (setq *h* 175))

(initget 6)

(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))

(if h (setq *h* h) (setq h *h*) )

(setq width0 (* 3 h(TxtWidth "STT" msp))

height (* 2 h))

(if str0

(setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))

(setq width1 (* 2 h(TxtWidth "Gia tri" msp))))

(if (> h 3)

(setq width0 (* (fix (/ width0 10))10)

width1 (* (fix (/ width1 10))10)

height (* (fix (/ height 5))5)))

(setq pt (getpoint "\nDiem dat Bang :")

TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width1))

(vla-put-regeneratetablesuppressed TblObj :vlax-true)

(vla-put-vertcellmargin TblObj (* 0.25 h))

(vla-put-horzcellmargin TblObj (* 0.75 h))

(vla-SetColumnWidth TblObj 0 width0)

(vla-SetColumnWidth TblObj 2 (* 2 h(TxtWidth "So luong" msp)))

(mapcar '(lambda (x)(vla-setTextHeight TblObj x h))

(list acTitleRow acHeaderRow acDataRow) )

(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))

(list acTitleRow acHeaderRow acDataRow))

(vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 2)) )))

(vla-setText TblObj 0 0 "Bang thong ke")

(vla-setText TblObj 1 0 "STT")

(vla-setText TblObj 1 1 "Gia tri")

(vla-setText TblObj 1 2 "So luong")

(setq i 1 row 2 )

(foreach e lst

(vla-setText TblObj row 0 (itoa i))

(vla-setText TblObj row 1 (car e))

(vla-setText TblObj row 2 (cdr e))

(vla-SetCellAlignment TblObj row 1 7)

(vla-SetCellAlignment TblObj row 2 9)

(setq row (1+ row) i (1+ i)) )

(vla-put-regeneratetablesuppressed TblObj :vlax-false)

(vlax-release-object TblObj) )

(alert "Khong chon duoc Text.") )

(princ) )

(alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)") ) )

2. Chuyển text vào file exel đã có sẵn trên ồ đĩa.

( ví dụ : file exel đó đang làm đến row 17 thì để trống một row và điền tiếp vào row 19)

Vì mình phải bóc bản vẽ theo từng tủ một mà một bản vẽ thì có rất nhiều tủ, nên nếu làm theo lip trên thì sẽ có rất nhiều file exel. Rồi lại mở từng file excel một cop vào file tổng hợp :)

Cảm ơn mọi người trước.

[thangbkpro 0]

Giúp em với các bác !