Đến nội dung


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

[Yêu cầu] Lisp xuất text theo thứ tự chọn ra excel


  • Please log in to reply
51 replies to this topic

#21 sanit

sanit

    biết vẽ line

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

Đã gửi 06 August 2012 - 10:42 PM

Bạn chú ý:
1.Code VBA mình viết bạn làm như sau
-Quét chọn lần lượt từng nhóm text của bạn, cứ đủ 8 text là xếp thành 1 hàng, nếu nó quét tận 10 text thì sẽ sang hàng thứ 2
-Nghĩa là: Bạn chỉ quét chọn 1 lần tất cả các Text mà bạn cần xếp theo nhóm sau đó nhấn Enter => VBA sẽ cho ra đúng như bạn yêu cầu
Nên mỗi hàng chắc chắc chỉ có 8 Text
Code bác Bình nếu có lỡ chọn >8 thì sẽ ra luôn tất cả, không format 1 hàng 8 Text ?
2.Nếu mỗi lần làm bạn chọn 8 Text thì đúng là mỗi lần 1 File :D
Thử lại xem :)


OK mình kiểm tra lại chuẩn rồi, thanks bạn :)!
  • 0

#22 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 07 August 2012 - 01:49 PM

Nhờ Bác Sơn và các Bác trên diễn đàn sửa VBA trên để lấy xuất text ra file excel. Xuất text từ file cad lấy text từ 2 cột cao độ tự nhiên và khoảng cách lẻ. Kết quả là được file excel như ví em upload lên .http://www.cadviet.c...72353_vidu1.rar
  • 0

#23 sanit

sanit

    biết vẽ line

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

Đã gửi 07 August 2012 - 02:23 PM

Nhờ Bác Sơn và các Bác trên diễn đàn sửa VBA trên để lấy xuất text ra file excel. Xuất text từ file cad lấy text từ 2 cột cao độ tự nhiên và khoảng cách lẻ. Kết quả là được file excel như ví em upload lên

Mình có file excel làm được công việc mà bạn yêu cầu, bạn xem video để biết cách sử dụng nhé.
Link file excel : http://www.cadviet.c..._sang_excel.rar
Mình up video lên sau, hiện tại youtube đang phê duyệt ^^
  • 0

#24 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 August 2012 - 04:24 PM

Code hoàn thiện cho bạn "sanit"
TKTver2.0
Code lần này có 1 số ưu điểm sau:
1.Chỉ xuất text là số, nếu bạn có lỡ chọn Text là chữ cũng không sao
2.Chỉ thực hiện khi số Text chia hết cho 8. Nếu bạn chọn số Text không chia hết cho 8 => Thoát hàm
3.Lưu ý: Chọn 1 lần quét tất cả Text cần xuất
4.Thêm chức năng kẻ bảng trong Cad, chiều cao chữ bằng chính chiều cao chữ bạn chọn
Thân!
http://www.cadviet.c...67_tktver20.rar
  • 0

#25 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 August 2012 - 04:26 PM

Nhờ Bác Sơn và các Bác trên diễn đàn sửa VBA trên để lấy xuất text ra file excel. Xuất text từ file cad lấy text từ 2 cột cao độ tự nhiên và khoảng cách lẻ. Kết quả là được file excel như ví em upload lên .http://www.cadviet.c...72353_vidu1.rar

Kết quả đã rõ, nhưng có lẽ 1 File cad sẽ tốt hơn
Nếu Pick lần lượt từng Text thì mỏi tay lắm :D
Cần File Cad để Auto nhanh hơn chăng ?
  • 1

#26 sanit

sanit

    biết vẽ line

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

Đã gửi 07 August 2012 - 04:35 PM

Mình post lại cái video, bạn down link post #23 nhé
Xem tạm link video tại đây, mình không biết post video như thế nào : http://www.youtube.c...h?v=15nALfRE7HM
  • 0

#27 sanit

sanit

    biết vẽ line

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

Đã gửi 07 August 2012 - 04:44 PM

Code hoàn thiện cho bạn "sanit"
TKTver2.0
Code lần này có 1 số ưu điểm sau:
1.Chỉ xuất text là số, nếu bạn có lỡ chọn Text là chữ cũng không sao
2.Chỉ thực hiện khi số Text chia hết cho 8. Nếu bạn chọn số Text không chia hết cho 8 => Thoát hàm
3.Lưu ý: Chọn 1 lần quét tất cả Text cần xuất
4.Thêm chức năng kẻ bảng trong Cad, chiều cao chữ bằng chính chiều cao chữ bạn chọn
Thân!
http://www.cadviet.c...67_tktver20.rar


Bạn thật nhiệt tình ^^ Thanks !
  • 0

#28 banbe0274

banbe0274

    biết vẽ pline

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

Đã gửi 07 August 2012 - 05:14 PM

Mình sử dụng VBA của Bác Sơn mà không được . Tại sao không chọn xuất được text bác nhỉ Các Bác bổ sung thêm code xuất được cả text nhé. Phần code của bác sanit em không sử dụng được vì máy tính của em chỉ sử dụng cad2007 và office2003 thôi.
  • 0

#29 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 August 2012 - 06:24 PM

Bạn chú ý, khái niệm Text và Mtext là khác nhau
Bạn đang nói Mtext chăng ?
  • 0

#30 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 August 2012 - 06:33 PM

Code cho bạn VBA Xuất Text cao độ KC lẻ và cao độ tự nhiên
Tải file về giải nén, Mở Cad Load (Lệnh AP) 2 file này vào
Sau đó đánh lệnh TKT, sẽ có hướng dẫn cụ thể
Thân !
http://www.cadviet.c...467_desktop.rar
  • 1

#31 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 27 October 2012 - 09:53 PM

Hề hề hề,
Phiền bạn test thử cái lisp này coi đã ưng ý chưa nhé.



(defun c:xtxt ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(setq fw (open tmp "w"))
(setq p1 (getpoint "\n Chon diem dat bang"))
(setq h (getreal "\n Nhap chieu cao chu: "))
(alert "\n Chon lan luot cac text can xuat trong mot nhom ")
(setq sst (ssget (list (cons 0 "*text"))))
(while sst
(setq sstl (acet-ss-to-list sst)
p2 (polar p1 0 (* 8 h))
p3 (polar p2 0 (* 8 h))
p4 (polar p3 0 (* 8 h))
p5 (polar p4 0 (* 8 h))
p6 (polar p5 0 (* 8 h))
p7 (polar p6 0 (* 8 h))
p8 (polar p7 0 (* 8 h))
p9 (polar p8 0 (* 8 h))
p11 (polar p1 (- (/ pi 2)) (* 4 h))
p12 (polar p2 (- (/ pi 2)) (* 4 h))
p13 (polar p3 (- (/ pi 2)) (* 4 h))
p14 (polar p4 (- (/ pi 2)) (* 4 h))
p15 (polar p5 (- (/ pi 2)) (* 4 h))
p16 (polar p6 (- (/ pi 2)) (* 4 h))
p17 (polar p7 (- (/ pi 2)) (* 4 h))
p18 (polar p8 (- (/ pi 2)) (* 4 h))
p19 (polar p9 (- (/ pi 2)) (* 4 h))
p21 (list (+ (car p1) (* 4 h)) (- (cadr p1) (* 2 h)))
k 0
txl ""
)
(command "pline" p1 p9 p19 p11 "c")
(command "pline" p2 p12 "" )
(command "pline" p3 p13 "" )
(command "pline" p4 p14 "" )
(command "pline" p5 p15 "" )
(command "pline" p6 p16 "" )
(command "pline" p7 p17 "" )
(command "pline" p8 p18 "" )
(foreach txt sstl
(setq t1 (cdr (assoc 1 (entget txt)))
txl (strcat txl t1 ",") )
(command "text" "j" "mc" (list (+ (car p21) (* k 8 h)) (cadr p21)) h 0 t1)
(setq k (1+ k ) )
)
(write-line txl fw)
(alert "\n Tiep tuc chon lan luot cac text can xuat cho nhom ke tiep")
(setq sst (ssget (list (cons 0 "*text"))))
(setq p1 p11)
)
(close fw)
(setvar "osmode" oldos)
(princ)
)
Chúc bạn vui.

Cám ơn Bạn.
Lisp của bạn khi xuất ra Excel rất chuẩn, mình xin nhờ bạn giúp cho việc : vì số lượng text cần xuất ra excel rất lớn, khi tạm ngưng muốn xuất tiếp tục và ghi nối và file cũ đã xuất trước đó, cho đỡ ghép các file lại với nhau.
Không cần việc xuất ra bảng cad mà chỉ ra và ghi vào file excel thôi
Cám ơn
  • 0

#32 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 October 2012 - 10:59 PM

Bạn sửa chữ "w" thành chữ "a" thì nó sẽ ghi nối vào file.
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#33 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 28 October 2012 - 07:23 AM

Mình đã sửa theo hướng dẫn. Không biết sao lisp xtxt thì máy nhà chạy được, còn chép vào laptop, hiện thông báo và ngưng không chọn tiếp , kén tùy file Cad.
chắt thiếu thông số gì trên file. Mong bạn giúp.
  • 0

#34 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 October 2012 - 07:36 AM

Bạn hãy nói rõ lỗi xuất hiện từ lúc nào trong quá trình chạy? Sau khi lỗi, nhấn F2, copy và paste lên đây xem. Tôi đang nghi ngờ ở 1 chỗ.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#35 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 28 October 2012 - 07:50 AM

Bạn hãy nói rõ lỗi xuất hiện từ lúc nào trong quá trình chạy? Sau khi lỗi, nhấn F2, copy và paste lên đây xem. Tôi đang nghi ngờ ở 1 chỗ.

Chon diem dat bang
Nhap chieu cao chu: 1

Select objects: Specify opposite corner: 6 found

Select objects:
; error: no function definition: ACET-SS-TO-LIST

Lỗi như thế này đó bạn
  • 0

#36 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 October 2012 - 07:58 AM

Vậy là cad trong laptop chưa cài Tool Express?
Bạn sửa dòng này:
(setq sstl (acet-ss-to-list sst)
Thành:
(setq sstl (vl-remove-if 'listp (mapcar 'cadr (ssnamex sst))))
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#37 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 28 October 2012 - 08:16 AM

Vậy là cad trong laptop chưa cài Tool Express?
Bạn sửa dòng này:
(setq sstl (acet-ss-to-list sst)
Thành:
(setq sstl (vl-remove-if 'listp (mapcar 'cadr (ssnamex sst))))

Laptop thấy Tool Express
Vẫn lổi như cũ, mình cần cài lại Cad không bạn ?
  • 0

#38 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 October 2012 - 08:20 AM

srr, bạn bỏ bớt 1 dấu ngoặc sau cùng, do tôi viết thừa. Như thế này nhé:
(setq sstl (vl-remove-if 'listp (mapcar 'cadr (ssnamex sst)))
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#39 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 28 October 2012 - 08:28 AM

Trên máy Pc mình chỉ thay W thanh a, chạy tốt và ghi đúng theo yêu cấu.
Còn Laptop thay a và dòng mới, lỗi vẫn như cũ.
  • 0

#40 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 October 2012 - 08:33 AM


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=65674&pid=217437&st=20&#entry217437
(defun c:xtxt ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv;txt" 1))
(setq fw (open tmp "a"))
(setq p1 (getpoint "\n Chon diem dat bang"))
(setq h (getreal "\n Nhap chieu cao chu: "))
(alert "\n Chon lan luot cac text can xuat trong mot nhom ")
(setq sst (ssget (list (cons 0 "*text"))))
(while sst
(setq sstl (vl-remove-if 'listp (mapcar 'cadr (ssnamex sst)))
; (setq sstl (acet-ss-to-list sst)
p2 (polar p1 0 (* 8 h))
p3 (polar p2 0 (* 8 h))
p4 (polar p3 0 (* 8 h))
p5 (polar p4 0 (* 8 h))
p6 (polar p5 0 (* 8 h))
p7 (polar p6 0 (* 8 h))
p8 (polar p7 0 (* 8 h))
p9 (polar p8 0 (* 8 h))
p11 (polar p1 (- (/ pi 2)) (* 4 h))
p12 (polar p2 (- (/ pi 2)) (* 4 h))
p13 (polar p3 (- (/ pi 2)) (* 4 h))
p14 (polar p4 (- (/ pi 2)) (* 4 h))
p15 (polar p5 (- (/ pi 2)) (* 4 h))
p16 (polar p6 (- (/ pi 2)) (* 4 h))
p17 (polar p7 (- (/ pi 2)) (* 4 h))
p18 (polar p8 (- (/ pi 2)) (* 4 h))
p19 (polar p9 (- (/ pi 2)) (* 4 h))
p21 (list (+ (car p1) (* 4 h)) (- (cadr p1) (* 2 h)))
k 0
txl ""
)
(command "pline" p1 p9 p19 p11 "c")
(command "pline" p2 p12 "" )
(command "pline" p3 p13 "" )
(command "pline" p4 p14 "" )
(command "pline" p5 p15 "" )
(command "pline" p6 p16 "" )
(command "pline" p7 p17 "" )
(command "pline" p8 p18 "" )
(foreach txt sstl
(setq t1 (cdr (assoc 1 (entget txt)))
txl (strcat txl t1 ",") )
(command "text" "j" "mc" (list (+ (car p21) (* k 8 h)) (cadr p21)) h 0 t1)
(setq k (1+ k ) )
)
(write-line txl fw)
(alert "\n Tiep tuc chon lan luot cac text can xuat cho nhom ke tiep")
(setq sst (ssget (list (cons 0 "*text"))))
(setq p1 p11)
)
(close fw)
(setvar "osmode" oldos)
(princ)
)

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.