Đến nội dung


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

AutoCAD với Excel


  • Please log in to reply
199 replies to this topic

#61 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 23 January 2008 - 12:26 PM

Lisp có những ưu thế tuyệt vời khi làm việc với Acad:
- Dễ dàng tạo các đối tượng Acad cũng như truy xuất dứ liệu từ chúng
- Gọi command của Acad rất đơn giản và tự nhiên như "người trong nhà"
- Các lệnh được tạo bằng lisp được Acad "đối xử bình đẳng" như các lệnh chính thống v.v…
Bên cạnh các ưu điểm trên, nhược điểm lớn nhất của Lisp là khả năng giao tiếp với bên ngoài rất hạn chế. Lâu nay, để truy xuất dữ liệu từ Excel, mình vẫn thường phải qua 1 trong 2 dạng file trung gian *.txt (Tab delimited - phân biệt các field bằng ký tự Tab) và *.csv (Comma delimited - phân biệt các field bằng dấu phẩy).
Nhược điểm này có thể khắc phục được bằng cách dùng ActiveX Automation.
Tổng quan về ActiveX, xin được trích dẫn Help:

"ActiveX Automation is a new way to work programmatically with the contents of an AutoCAD drawing. In many instances, ActiveX works faster than traditional AutoLISP functions in manipulating AutoCAD drawing objects.
The ActiveX programming interface is usable from a number of languages and environments, such as C++, Visual BasicTM, and DelphiTM. When you work with ActiveX objects in AutoLISP, you work with the same object model, properties, and methods that can be manipulated from other programming environments."

Translation:
ActiveX Automation là một phương pháp mới để lập trình với AutoCAD. Trong nhiều trường hợp, ActiveX làm việc nhanh hơn các hàm AutoLisp truyền thống trong việc xử lý các đối tượng AutoCAD.
ActiveX có thể dùng được với một số ngôn ngữ và môi trường lập trình như C++, VB và Delphi. Khi làm việc với ActiveX trong AutoLisp, bạn thao tác với Objects – Properties – Methods giống như trong những môi trường lập trình nói trên.

Visual Lisp cung cấp một số hàm dạng vlax-xxxx để làm việc với ActiveX. Thực tế là từ trước đến nay, bản thân mình cũng chưa có điều kiện nghiên cứu sâu về chúng. Khó khăn lớn nhất là không có tài liệu, ngay cả Help của Acad cũng hướng dẫn sơ sài. Tuy chưa biết nhiều, nhưng mình thấy mảng này khá hay. Làm chủ được nó, chúng ta có thể dùng Lisp truy xuất dữ liệu trực tiếp từ các ứng dụng khác (Excel là 1 ví dụ), không phải “nhiêu khê” như trước nữa.

Một ví dụ minh họa để các bạn thử nghiệm:

(defun C:GED();;;Get Excel Data
(vl-load-com)
(setq
ex (vlax-get-object "Excel.Application")
sl (vlax-get-property ex 'selection)
txtvr (vlax-get-property sl 'text)
txt (vlax-variant-value txtvr)
ir (vlax-get-property sl 'row)
ic (vlax-get-property sl 'column)
)
(alert
(strcat
"\nContent: " txt
"\nColumn: " (chr (+ ic 64))
"\nRow: " (itoa ir)
)
)
)
Trình tự thử:
- Appload đoạn lisp trên
- Khởi động Excel, open 1 file *.xls nào đó
- Pick chọn 1 cell bất kỳ (có chứa dữ liệu để kiểm tra)
- Sang Acad, gõ lệnh GED để thử
Kết quả: 1 message_box ghi thông tin về nội dung, chỉ số cột và hàng của cell mà bạn đã chọn.

Đặt vấn đề:
1) Đã lấy được dữ liệu của 1 cell thì tất nhiên sẽ lấy được dữ liệu của cả sheet, và đã import được thì tất nhiên cũng export được. Bằng cách nào thì mời các bạn có hứng thú với cái này “ngâm cứu” tiếp. Trước mắt, chỉ cần lấy được dữ liệu của một vùng được selected trong bảng Excel đang hiện hành (ví dụ như B3:F17 chẳng hạn) là đã ứng dụng được cho khối việc rồi.
2) Các thao tác trên hoàn toàn không dùng đến kho libraries của bất cứ trình ứng dụng nào. Phải nhờ vả đến “đám” này rất là phiền toái vì sự không tương thích giữa các version. Nếu phải dùng đến libraries, khi người ta nâng cấp version của Excel, rất nhiều khả năng chương trình của chúng ta sẽ không chạy được. Bản thân ssg ít thích dùng VB chính vì nó phụ thuộc vào các libraries quá nhiều!
Để khẳng định điều này, ssg nhờ các bạn kiểm tra giúp xem đoạn lisp trên có làm việc được với mọi version của AutoCAD cũng như Excel hay không? Ssg đã thử với Cad2002, Cad2007 và Excel2003, kết quả OK.
3) Các bạn thường lập trình với VB và ActiveX có kinh nghiệm hoặc tài liệu gì (tiếng Việt hoặc tiếng Anh đều tốt) về vấn đề này xin được chia sẻ.

Cám ơn tất cả các bạn,

Quá hay, nhấn nút Thank cũng chưa đã, phải Thank bằng lời mới được, đã test trên các version 2004,2005 , kết quả như ý, nhưng trên R14 thì báo lỗi sau:
Command: ged
error: null function
(VL-LOAD-COM)
(C:GED)
*Cancel*
Ssg viết tiếp đi, không những hiển thị dữ liệu 1 cell mà lấy cả dữ liệu của 1 row
  • 1

#62 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 23 January 2008 - 01:39 PM

... đã test trên các version 2004,2005 , kết quả như ý, nhưng trên R14 thì báo lỗi sau:
Command: ged
error: null function
(VL-LOAD-COM)
(C:GED)
*Cancel*
Ssg viết tiếp đi, không những hiển thị dữ liệu 1 cell mà lấy cả dữ liệu của 1 row

Mình nhớ không lầm thì R14 chưa hỗ trợ vla-xxxx functions, đành chịu thôi. Theo ssg, dù computer có "bèo" mấy đi nữa cũng chơi được thằng 2002 chứ? R14 đã xong "sứ mạng lịch sử" của nó rồi, có lẽ nên xếp vào viện bảo tàng?!
Còn việc phát triển kỹ thuật ActiveX thì trên nguyên tắc chắc chắn là được, không phải chỉ lấy dữ liệu của 1 row mà là cả sheet, nhưng... hãy đợi đấy! Chẳng có tài liệu gì cả, chỉ mò mẫm làm theo kiểu thử sai, mất thời gian lắm!

Mình quên, còn 1 chiêu nữa để tìm hiểu VLA-Objects:
- Cú pháp: (vlax-dump-object obj [T])
- Công dụng: Lists an object's properties, and optionally, the methods that apply to the object. If specified, vlax-dump-object also lists all methods that apply to obj.
- Arguments: VLA-object, [T: true, optional]
- Return Values: T, if successful. If an invalid object name is supplied, vlax-dump-object displays an error message.
- Ví dụ: với biến ex nhận được ở trên, các bạn dùng (vlax-dump-object ex T), bấm F2 xem. Nó xổ ra đúng là một dump (đống) các Properties và Methods, tha hồ mà "ngâm cứu"!
  • 0

#63 Nộ Thiên

Nộ Thiên

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 297 Bài viết
Điểm đánh giá: 133 (tàm tạm)

Đã gửi 23 January 2008 - 02:35 PM

Có cái này kg biết giúp ích gì cho Bác Ssg kg?
Cái này down đã lâu nhưng chưa rãnh ngcứu đc.
Thấy Bác quan tâm đến vấn đề này, gửi Bác ngcứu.
http://www.cadviet.c...oft_Excel_.code
  • 1

#64 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 23 January 2008 - 03:02 PM

Có cái này kg biết giúp ích gì cho Bác Ssg kg?
Cái này down đã lâu nhưng chưa rãnh ngcứu đc.
Thấy Bác quan tâm đến vấn đề này, gửi Bác ngcứu.
http://www.cadviet.com/upfiles/Obtaining_v...oft_Excel_.code

Nhận xét sơ bộ:
- Theo giới thiệu của chương trình thì đúng mục đích của mình.
- Cần phải thêm vào đầu chương trình hàm (vl-load-com). Đây là thủ tục bắt buộc, load Visual Lisp Extensions trước khi gọi các functions vla-xxxx
- Thêm vào rồi nhưng chạy vẫn lỗi, chưa rõ từ đâu:
Command: (get_xl tbl)
; error: Automation Error. Too many fields defined. (chưa biết thừa cái gì!)
- Từ từ đọc hết code của nó, dù không chạy được chắc cũng hiểu ra thêm cái gì đó hữu ích...

Cám ơn sự quan tâm và chia sẻ của bạn.
  • 1

#65 Nộ Thiên

Nộ Thiên

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 297 Bài viết
Điểm đánh giá: 133 (tàm tạm)

Đã gửi 23 January 2008 - 04:50 PM

; error: Automation Error. Too many fields defined. (chưa biết thừa cái gì!)


Mình chạy thì đc cái này:
Command: (setq tbl "D:\\ZThien\\DO-ING\\test-noCAD\\7.xls")
"D:\\ZThien\\DO-ING\\test-noCAD\\7.xls"

Command: (GET_xl tbl)
(("Sheet1$" (1.0 2.0 4.0 8.0) (2.0 3.0 5.0 9.0) (3.0 4.0 6.0 10.0) (4.0 5.0 7.0
11.0) (5.0 6.0 8.0 12.0) (6.0 7.0 9.0 13.0) (7.0 8.0 10.0 14.0) (8.0 9.0 11.0
15.0) (9.0 10.0 12.0 16.0)) ("Sheet2$") ("Sheet3$"))


Còn đây là file excel
Hình đã gửi
Hình đã gửi

Và đây là file lisp:
http://www.cadviet.c...es/get_xl_1.lsp

Nghe Bác ssg nói lỗi, mình liền chạy thử nhưng kg thấy lỗi gì cả!?
Bác ssg kiểm tra lại.
  • 0

#66 Nộ Thiên

Nộ Thiên

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 297 Bài viết
Điểm đánh giá: 133 (tàm tạm)

Đã gửi 23 January 2008 - 05:13 PM

- Cần phải thêm vào đầu chương trình hàm (vl-load-com). Đây là thủ tục bắt buộc, load Visual Lisp Extensions trước khi gọi các functions vla-xxxx

Để test thì đưa vào.
nhưng sau này thì: vì(Get-xl )là 1 hàm con nên (vl-load-com) sẽ đc đưa vào chương trình chính.
  • 0

#67 quoccuongvkt

quoccuongvkt

    biết vẽ arc

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

Đã gửi 23 January 2008 - 07:05 PM

có bác nào có list chuyển từ exell sang cad xin gởi cho mình với, mình làm thống kêt thép trên exell nhưng mà chuyển qua cad rất khó khăn
  • 0

#68 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 24 January 2008 - 08:25 AM

Nghe Bác ssg nói lỗi, mình liền chạy thử nhưng kg thấy lỗi gì cả!?
Bác ssg kiểm tra lại.

I'm sorry!
Hôm qua mình lấy 1 file *.xls bất kỳ có sẵn thì lỗi như vậy. Xem kỹ file bị lỗi cũng chẳng có gì bất thường, chưa hiểu nguyên nhân! Mình up lên bạn xem thử:
http://www.cadviet.com/upfiles/vd.xls
Hôm nay mình đã thử lại với rất nhiều file khác, kết quả tuyệt vời. Một lần nữa, cám ơn bạn nhiều.
Còn một chút "lăn tăn" là tại sao file kia bị lỗi? Tìm ra nguyên nhân mới yên tâm được!
  • 0

#69 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 24 January 2008 - 08:54 AM

có bác nào có list chuyển từ exell sang cad xin gởi cho mình với, mình làm thống kêt thép trên exell nhưng mà chuyển qua cad rất khó khăn

Xin góp ý nhẹ nhàng:
1) Bạn là dân kỹ thuật, nên cẩn trọng và có trách nhiệm hơn về những gì mình viết. Chỉ một đoạn ngắn mà có đến mấy lỗi sai từ (đánh dấu đỏ trên)
2) Bạn nêu yêu cầu chưa rõ ý lắm. Bạn cần chuyển cái gì qua CAD? Toàn bộ sheet, một phần sheet, hay chuyển dữ liệu cho chương trình lisp nào đó xử lý theo ý đồ riêng?
3) Nếu chuyển toàn bộ sheet, bạn đã thử dùng lệnh như sau chưa:
Menu - Insert - OLE Object - Create from file - Browse - Chọn file *.xls - Open - OK
Nếu cách trên không hợp ý, bạn hãy trình bày lại để người khác hiểu rõ hơn ý bạn muốn gì.
  • 0

#70 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 24 January 2008 - 10:16 AM

Còn một chút "lăn tăn" là tại sao file kia bị lỗi? Tìm ra nguyên nhân mới yên tâm được!

Mình biết nguyên nhân rồi, nếu trong sheet có dữ liệu thì row 1 không được phép để trống!
  • 0

#71 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 24 January 2008 - 10:32 AM

có bác nào có list chuyển từ exell sang cad xin gởi cho mình với, mình làm thống kêt thép trên exell nhưng mà chuyển qua cad rất khó khăn


Bạn mở EXCEL chọn vùng cần chuyển.
Sang ACAD chọn edit -> paste special... -> autocad entities
Chỉ 1 điểm nó sẽ chuyển sang thành đối tượng cad cho bạn.
Đối cad14 thì nó chuyển được cả các nét vẽ hình dáng thép cón các cadkhác thì hình như chỉ qua khung và text.
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#72 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 24 January 2008 - 05:08 PM

Xử lý tốt sự liên kết giữa Lisp và Excel sẽ mở ra nhiều khả năng để tạo nên những ứng dụng rất hiệu quả.
Mình nhờ tất cả các bạn quan tâm đến chủ đề này một việc: kiểm tra giúp đoạn lisp sau có chạy được với mọi version của Acad lẫn Excel hay không (đặc biệt chú trọng đến version của Excel). Mình đã thử với Cad2002, Cad2007 và Excel 2003, kết quả OK.
Trình tự test:
1) Tạo 1 file Excel đơn giản và ngắn, chừng vài hàng vài cột, tương tự như bảng mà bạn Nộ Thiên đã post ở trên (để cho nhanh và dễ kiểm tra kết quả). Không nên dùng tiếng Việt có dấu. Chú ý: không được bỏ trống row1.
2) Lưu file dạng *.xls bình thường và thoát hẳn trình Excel đang chạy.
3) Appload đoạn code sau và gõ lệnh TEST
Nếu kết quả tốt, sẽ hiện ra message_box với đầy đủ số liệu bố trí như bên Excel. Kết quả thử với các version thế nào phiền các bạn báo lại cho mình biết.
Cám ơn rất nhiều,
Ssg


;;;-----------------------------------------------------
(defun C:TEST( / fn d s x y)
(vl-load-com)
(setq
fn (getfiled "Select Data File" "" "xls" 0)
d (cdr (car (get_xl fn)))
s ""
)
(foreach x d
(foreach y x
(if (= y nil) (setq y ""))
(if (/= (type y) 'STR) (setq y (rtos y)))
(setq s (strcat s y "\t"))
)
(setq s (strcat s "\n"))
)
(alert s)
)

;;;-----------------------------------------------------
(defun rec-rem-dupl (lst)
(if lst
(cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
) ;_ if
) ;_ defun
;;;-----------------------------------------------------
(defun GET_xl (tbl / ADOCONNECT ADORECORDSET LST)
(setq
ADOConnect (vlax-get-or-create-object "ADODB.Connection")
ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
) ;_ setq
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-invoke-method)
(list
ADOConnect
"Open"
(strcat
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
tbl
";Extended Properties=;Excel 8.0;HDR=No"
) ;_ strcat
"admin"
""
nil
) ;_ list
) ;_ vl-catch-all-apply
) ;_ vl-catch-all-error-p
) ;_ not
(progn
(setq
lst (mapcar
(function
(lambda (l / i c)
(vlax-invoke-method
ADORecordset
"Open"
(strcat "SELECT * FROM [" l "]")
ADOConnect
1
3
nil
) ;_ vlax-invoke-method
(setq
i (length
(car
(vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
ADORecordset
"GetRows"
65535
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ car
) ;_ length
) ;_ setq
(vlax-invoke-method ADORecordset "Close")
(while (not (zerop i))
(vlax-invoke-method
ADORecordset
"Open"
(strcat "SELECT * FROM [" l "a" (itoa i) ":IV" (itoa i) "]")
ADOConnect
1
3
nil
) ;_ vlax-invoke-method
(setq
c (cons
(car
(apply
(function mapcar)
(cons
'list
(mapcar
(function
(lambda (a)
(mapcar
(function
(lambda (:)
(vlax-variant-value :)
) ;_ lambda
) ;_ function
a
) ;_ mapcar
) ;_ lambda
) ;_ function
(vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
ADORecordset
"GetRows"
65535
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ mapcar
) ;_ cons
) ;_ apply
) ;_ car
c
) ;_ cons
i (1- i)
) ;_ setq
(vlax-invoke-method ADORecordset "Close")
) ;_ while
(if (equal c '((nil) (nil)))
(list l)
(cons l c)
) ;_ if
) ;_ lambda
) ;_ function
(rec-rem-dupl
(caddr
(mapcar
(function
(lambda (a)
(mapcar
(function vlax-variant-value)
a
) ;_ mapcar
) ;_ lambda
) ;_ function
(vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method
(vlax-invoke-method
ADOConnect
"OpenSchema"
4
) ;_ vlax-invoke-method
"GetRows"
65535
) ;_ vlax-invoke-method
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ apply
) ;_ caddr
) ;_ rec-rem-dupl
) ;_ mapcar
) ;_ setq
(vlax-invoke-method ADOConnect "Close")
(vlax-release-object ADORecordset)
(vlax-release-object ADOConnect)
(setq ADORecordset nil
ADOConnect nil
) ;_ setq
lst
) ;_ progn
(progn
(vl-catch-all-apply
'vlax-invoke-method
(list ADOConnect "Close")
) ;_ vl-catch-all-apply
(vlax-release-object ADORecordset)
(vlax-release-object ADOConnect)
(setq ADORecordset nil
ADOConnect nil
) ;_ setq
nil
) ;_ progn
) ;_ if
) ;_ defun

  • 0

#73 Nộ Thiên

Nộ Thiên

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 297 Bài viết
Điểm đánh giá: 133 (tàm tạm)

Đã gửi 24 January 2008 - 06:37 PM

(mapcar
(function
(lambda (:)
(vlax-variant-value :)
) ;_ lambda
) ;_ function
a
) ;_ mapcar
) ;_ lambda
) ;_ function

Nên đưa file lên đi Bác SSg ơi, bởi vì kí tự " b )" trở thành icon mất.
Hôm trước mình post kiểu này kg đc nên mới gửi file lsp lên đó.
  • 1

#74 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 25 January 2008 - 04:24 PM

Nên đưa file lên đi Bác SSg ơi, bởi vì kí tự " b )" trở thành icon mất.
Hôm trước mình post kiểu này kg đc nên mới gửi file lsp lên đó.

Cám ơn bạn đã nhắc nhở, mình sơ ý không xem lại. Hình như lỗi này admin bó tay?
Nếu link trên không down được, các bạn down ở đây:

http://www.esnips.co...6d5/data_excel2

Cái này rất quan trọng, trước mắt là sẽ dùng cho một số module của chương trình LandCadViet Utility. Mong các bạn có điều kiện test giúp.
Một lần nữa, cám ơn nhiều!
  • 0

#75 acad_mem

acad_mem

    biết zoom

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

Đã gửi 31 January 2008 - 02:33 PM

Tôi muốn các bạn chia sẽ cách nhập và xuất số liệu giữa Autocad và Excel, được viết bằng ngôn ngữ AutoLISP. nếu được có thể cho xem ví dụ mẫu.
Cám ơn.


Uhm, tui search google được nhiều lắm này. :)
(defun Txt->Excel(/ Boucle Ent Excel_Lance Js Objet_Excel Rng Xl Xl_Classeur Xl_Feuilles Xl_Feuille_Active)
(if (car (setq Objet_Excel (Liaison_Excel)))
(progn
(princ (strcat "\nConnexion avec Excel " (cadr Objet_Excel)))
(princ)
(if (setq Xl (vlax-get-object "Excel.Application"))
(setq Excel_Lance T)
(setq Xl (vlax-create-object "Excel.Application"))
)
(if Xl
(progn
(if (null Xl-open)
(vlax-import-type-library
:tlb-filename (car Objet_Excel)
:methods-prefix "Xl-"
:properties-prefix "Xlp-"
:constants-prefix "Xlc-")
)
(if (not Excel_Lance)
(vlax-invoke-method (vlax-get-property Xl 'WorkBooks) 'Add)
)
(setq Xl_Classeur (vlax-get-property XL "ActiveWorkbook"))
(setq Xl_Feuilles (vlax-get Xl_Classeur "Sheets"))
(setq Boucle 1)
(while (<= Boucle (xlp-get-count Xl_Feuilles))
(if (= (xlp-get-name (xlp-get-item Xl_Feuilles Boucle))(getvar "dwgname"))
(progn
(setq Xl_Feuille_Active (xlp-get-item Xl_Feuilles Boucle))
(xl-activate Xl_Feuille_Active)
)
)
(setq Boucle (1+ Boucle))
)
(if (not Xl_Feuille_Active)
(progn
(setq Xl_Feuille_Active (xl-add (vlax-get Xl_Classeur "Sheets")))
(xlp-put-name Xl_Feuille_Active (getvar "dwgname"))
)
)
(vla-put-visible Xl 1)
(setq Boucle 0)
(if (setq Js (ssget "x" (list (cons 0 "MTEXT,TEXT"))))
(progn
(while (setq Ent (ssname Js Boucle))
(setq Ent (entget Ent))
(setq Rng (xlp-get-range Xl_Feuille_Active (strcat "A" (itoa (1+ Boucle)))))
(xlp-put-value2 Rng (cdr (assoc 1 Ent)))
(setq Boucle (1+ Boucle))
)
(vla-put-visible (vlax-get-acad-object) 1)
)
)
)
)
)
)
)
  • 0

#76 acad_mem

acad_mem

    biết zoom

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

Đã gửi 31 January 2008 - 02:34 PM

Tôi muốn các bạn chia sẽ cách nhập và xuất số liệu giữa Autocad và Excel, được viết bằng ngôn ngữ AutoLISP. nếu được có thể cho xem ví dụ mẫu.
Cám ơn.


Uhm, tui search google được nhiều lắm này. :)
(defun Txt->Excel(/ Boucle Ent Excel_Lance Js Objet_Excel Rng Xl Xl_Classeur Xl_Feuilles Xl_Feuille_Active)
(if (car (setq Objet_Excel (Liaison_Excel)))
(progn
(princ (strcat "\nConnexion avec Excel " (cadr Objet_Excel)))
(princ)
(if (setq Xl (vlax-get-object "Excel.Application"))
(setq Excel_Lance T)
(setq Xl (vlax-create-object "Excel.Application"))
)
(if Xl
(progn
(if (null Xl-open)
(vlax-import-type-library
:tlb-filename (car Objet_Excel)
:methods-prefix "Xl-"
:properties-prefix "Xlp-"
:constants-prefix "Xlc-")
)
(if (not Excel_Lance)
(vlax-invoke-method (vlax-get-property Xl 'WorkBooks) 'Add)
)
(setq Xl_Classeur (vlax-get-property XL "ActiveWorkbook"))
(setq Xl_Feuilles (vlax-get Xl_Classeur "Sheets"))
(setq Boucle 1)
(while (<= Boucle (xlp-get-count Xl_Feuilles))
(if (= (xlp-get-name (xlp-get-item Xl_Feuilles Boucle))(getvar "dwgname"))
(progn
(setq Xl_Feuille_Active (xlp-get-item Xl_Feuilles Boucle))
(xl-activate Xl_Feuille_Active)
)
)
(setq Boucle (1+ Boucle))
)
(if (not Xl_Feuille_Active)
(progn
(setq Xl_Feuille_Active (xl-add (vlax-get Xl_Classeur "Sheets")))
(xlp-put-name Xl_Feuille_Active (getvar "dwgname"))
)
)
(vla-put-visible Xl 1)
(setq Boucle 0)
(if (setq Js (ssget "x" (list (cons 0 "MTEXT,TEXT"))))
(progn
(while (setq Ent (ssname Js Boucle))
(setq Ent (entget Ent))
(setq Rng (xlp-get-range Xl_Feuille_Active (strcat "A" (itoa (1+ Boucle)))))
(xlp-put-value2 Rng (cdr (assoc 1 Ent)))
(setq Boucle (1+ Boucle))
)
(vla-put-visible (vlax-get-acad-object) 1)
)
)
)
)
)
)
)
  • 0

#77 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 31 January 2008 - 03:13 PM

Cám ơn bạn đã nhắc nhở, mình sơ ý không xem lại. Hình như lỗi này admin bó tay?
Nếu link trên không down được, các bạn down ở đây:

http://www.esnips.com/doc/f8166534-fce9-4d...6d5/data_excel2

Cái này rất quan trọng, trước mắt là sẽ dùng cho một số module của chương trình LandCadViet Utility. Mong các bạn có điều kiện test giúp.
Một lần nữa, cám ơn nhiều!

Đã test trên Office 2000, Ok, nhưng Office 2002 báo lỗi sau:
Command: test
; error: Automation Error. The Microsoft Jet database engine could not find the
object 'Documents_arraya16:IV16'. Make sure the object exists and that you
spell its name and the path name correctly.
  • 1

#78 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 31 January 2008 - 04:20 PM

Đã test trên Office 2000, Ok, nhưng Office 2002 báo lỗi sau:
Command: test
; error: Automation Error. The Microsoft Jet database engine could not find the
object 'Documents_arraya16:IV16'. Make sure the object exists and that you
spell its name and the path name correctly.

Cám ơn bạn, mình sẽ xem lại sau. Cái này cũng khá lôi thôi!
Bạn nào có office khác test thêm giúp.
  • 0

#79 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 01 February 2008 - 10:40 PM

Cám ơn bạn, mình sẽ xem lại sau. Cái này cũng khá lôi thôi!
Bạn nào có office khác test thêm giúp.

Đã test trên office 97, OK
  • 0

#80 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 02 February 2008 - 01:31 PM

Nhờ các bạn xem giúp, cái lisp dưới thực hiện được những công việc gì, cách sử dụng lệnh lisp này làm sao. (mới down về đọc qua chẳng hiểu gì cả, chán quá, đúng là chẳng hiểu gì về lisp cả :)


(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Column# ColumnRow@ Data@ ExcelRange^
ExcelValue ExcelValue ExcelVariant^ MaxColumn# MaxRow# Range$ Row# Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (not (findfile ExcelFile$))
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(progn
(alert "Excel file not specified.")
(exit)
);progn
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(if SheetName$
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
);if
(setq ColumnRow@ (ColumnRow MaxRange$))
(setq MaxColumn# (nth 0 ColumnRow@))
(setq MaxRow# (nth 1 ColumnRow@))
(setq *ExcelData@ nil)
(setq Row# 1)
(repeat MaxRow#
(setq Data@ nil)
(setq Column# 1)
(repeat MaxColumn#
(setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
(setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
(setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
(setq ExcelValue (vlax-variant-value ExcelVariant^))
(setq ExcelValue
(cond
((= (type ExcelValue) 'INT) (itoa ExcelValue))
((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
((/= (type ExcelValue) 'STR) "")
);cond
);setq
(setq Data@ (append Data@ (list ExcelValue)))
(setq Column# (1+ Column#))
);repeat
(setq *ExcelData@ (append *ExcelData@ (list Data@)))
(setq Row# (1+ Row#))
);repeat
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil)
*ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
(setq ColumnRow@ (ColumnRow Cell$))
(setq Column# (1- (nth 0 ColumnRow@)))
(setq Row# (1- (nth 1 ColumnRow@)))
(setq Return "")
(if *ExcelData@
(if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
(setq Return (nth Column# (nth Row# *ExcelData@)))
);if
);if
Return
);defun GetCell
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
; ExcelFile$ = Excel filename or nil for new spreadsheet
; SheetName$ = Sheet name or nil for not specified
; Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (findfile ExcelFile$)
(setq *ExcelFile$ ExcelFile$)
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(setq *ExcelFile$ "")
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(if ExcelFile$
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(if Visible
(vla-put-visible *ExcelApp% :vlax-true)
);if
(if (= (type SheetName$) 'STR)
(progn
(vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
(setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
);vlax-for
(if (member SheetName$ Sheets@)
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
(vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
);if
);progn
);if
(princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
; StartCell$ = Starting Cell ID
; Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
(if (= (type Data@) 'STR)
(setq Data@ (list Data@))
)
(setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
(if (Cell-p StartCell$)
(setq Column# (car (ColumnRow StartCell$))
Row# (cadr (ColumnRow StartCell$))
);setq
(if (vl-catch-all-error-p
(setq Cell$ (vl-catch-all-apply 'vlax-get-property
(list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
);setq
);vl-catch-all-error-p
(alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
(setq Column# (vlax-get-property Cell$ "Column")
Row# (vlax-get-property Cell$ "Row")
);setq
);if
);if
(if (and Column# Row#)
(foreach Item Data@
(vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
(setq Column# (1+ Column#))
);foreach
);if
(princ)
);defun PutCell
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
; ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
(if ExcelFile$
(if (= (strcase ExcelFile$) (strcase *ExcelFile$))
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
(setq Saveas t)
);if
(if (findfile ExcelFile$)
(progn
(vl-file-delete (findfile ExcelFile$))
(setq Saveas t)
);progn
(setq Saveas t)
);if
);if
);if
(if Saveas
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
"SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
);vlax-invoke-method
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil *ExcelFile$ nil)
(princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
(setq Column$ "")
(while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
(setq Column$ (strcat Column$ Char$)
Cell$ (substr Cell$ 2)
);setq
);while
(if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
(list (Alpha2Number Column$) Row#)
'(1 1);default to "A1" if there's a problem
);if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
(if (= 0 (setq Num# (strlen Str$)))
0
(+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
(Alpha2Number (substr Str$ 2))
);+
);if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
(if (< Num# 27)
(chr (+ 64 Num#))
(if (= 0 (setq Val# (rem Num# 26)))
(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
);if
);if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
(and (= (type Cell$) 'STR)
(or (= (strcase Cell$) "A1")
(not (equal (ColumnRow Cell$) '(1 1)))
);or
);and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
; RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
(setq DimZin# (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq ShortReal$ (rtos RealNum~ 2 8))
(setvar "DIMZIN" DimZin#)
ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp

  • 1