Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
ainhandilac

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

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

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)

)

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
vndesperados    253
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...

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
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é

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
vndesperados    253
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))
)

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

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
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)

)

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
ssg    1.088
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!")
)
)

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

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
thangbkpro    0

Cảm ơn bạn ainhandilacSSG 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.

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  

×