Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 28 August 2007 - 09:36 AM

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)
)
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#2 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 28 August 2007 - 09:44 AM

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...
  • 0

#3 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 28 August 2007 - 09:49 AM

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é
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#4 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 28 August 2007 - 10:12 AM

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

  • 0

#5 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 28 August 2007 - 10:26 AM

(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!
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#6 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 28 August 2007 - 01:20 PM

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)
)
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#7 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 28 August 2007 - 01:50 PM

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

  • 0

#8 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 28 August 2007 - 02:37 PM

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
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#9 thangbkpro

thangbkpro

    biết zoom

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

Đã gửi 31 October 2010 - 03:53 PM

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

#10 thangbkpro

thangbkpro

    biết zoom

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

Đã gửi 01 November 2010 - 08:56 AM

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