Chuyển đến nội dung
Diễn đàn CADViet
phantuhuong

Ứng dụng VBA Automation trong việc trao đổi dữ liệu giữa Excel với Autocad

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

Để so sánh giữa 2 môi trường, tôi thực hiện bài toán đơn giản nhất cho dễ hiểu. Hai thủ tục viết trong Excel và AutoCad như sau:

 

 

Trong Excel

Public AcadApp As AcadApplication

Sub Hinh_Tru_Excel()
Dim i As Integer
Dim AcadMo As AcadModelSpace
Dim AcadUt As AcadUtility
Dim DiemDauP As Variant		     'Diem dau tien de ve
Dim DiemBaoP(0 To 11) As Double     'Diem bao phan to mat cat
'Khai bao ghi ky hieu Ten lop
Dim GhiTenlopP(0 To 2) As Double
Dim Tenlop As String
Dim TenlopT As AcadText
'Khai bao ghi do sau lop
Dim GhiDosauP(0 To 2) As Double
Dim DosauT As AcadText
'Khai bao To mat cat
Dim MatcatH As AcadHatch
Dim VongbaoPL(0) As AcadPolyline
'Khai bao noi dung Hinh tru
Dim HinhTruP(0 To 2) As Double
Dim HinhTruT As AcadText
'Khai bao ty le dung Hinh tru
Dim TLdung As Single
Dim TLdungP(0 To 2) As Double
Dim TLdungT As AcadText
'Khai bao chieu rong cua phan To ky hieu dia tang va Pi
Const Chieurong = 10:  Const Pi = 3.14159
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call KhoidongAutoCad
'Thiet lap font ".VnArial" cho kieu "Standard"
Set TxtStyleObj = AcadApp.ActiveDocument.TextStyles.Item("Standard")
	TxtStyleObj.SetFont ".VnArial", False, False, 0, 34
'Xac dinh Ty le dung
TLdung = Val(ThisWorkbook.Sheets("Khai bao").Range("J3"))
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set AcadMo = AcadApp.ActiveDocument.ModelSpace
Set AcadUt = AcadApp.ActiveDocument.Utility
DiemDauP = AcadUt.GetPoint(, "Vao vi tri dau tien:")
'Ghi noi dung ten Hinh tru va Ty le dung
HinhTruP(0) = DiemDauP(0) + 8
HinhTruP(1) = DiemDauP(1) + 4
Set HinhTruT = AcadMo.AddText("HINH TRU HO KHOAN", HinhTruP, 1.5)
TLdungP(0) = HinhTruP(0) + 5
TLdungP(1) = HinhTruP(1) - 2.5
Set TLdungT = AcadMo.AddText("Tû lÖ ®øng: 1/" & TLdung, TLdungP, 1)
	TLdungT.ObliqueAngle = 0.15
DiemBaoP(0) = DiemDauP(0)
DiemBaoP(1) = DiemDauP(1)
'Tao vong lap duyet qua tung lop
With ThisWorkbook.Worksheets("Khai bao").Range("B2")
	i = 1
	Do
		'Xac dinh do chenh sau giua cac lop dat
		Chenhsau = (.Offset(i - 1, 1) - .Offset(i, 1)) * 1000 / TLdung
		'Xac dinh cac diem bao va ve duong Polyline
		DiemBaoP(3) = DiemBaoP(0) + Chieurong: DiemBaoP(4) = DiemBaoP(1)
		DiemBaoP(6) = DiemBaoP(3): DiemBaoP(7) = DiemBaoP(4) + Chenhsau
		DiemBaoP(9) = DiemBaoP(6) - Chieurong: DiemBaoP(10) = DiemBaoP(7)
		Set VongbaoPL(0) = AcadMo.AddPolyline(DiemBaoP)
			VongbaoPL(0).Closed = True  'Kep kin duong Polyline
			VongbaoPL(0).Color = acRed
		'Ghi ten cac lop dat
		GhiTenlopP(0) = DiemBaoP(3) + 2
		GhiTenlopP(1) = DiemBaoP(4) + Chenhsau / 2
		Tenlop = "Líp " & .Offset(i, 0) & ": " & .Offset(i, 2)
		Set TenlopT = AcadMo.AddText(Tenlop, GhiTenlopP, 0.8)
		'Ghi do sau lop
		GhiDosauP(0) = DiemBaoP(6) + 0.5
		GhiDosauP(1) = DiemBaoP(7)
		Set DosauT = AcadMo.AddText(FormatNumber(.Offset(i, 1), 1), GhiDosauP, 1)
			DosauT.Color = acRed
		'To ky hieu mat cat dia tang
		Set MatcatH = AcadMo.AddHatch(1, .Offset(i, 4), True)
			MatcatH.PatternScale = .Offset(i, 5)
			MatcatH.PatternAngle = .Offset(i, 6) * Pi / 180
			MatcatH.AppendOuterLoop (VongbaoPL)
			MatcatH.Evaluate: MatcatH.Update
		'Gan diem de sang lop moi
		DiemBaoP(0) = DiemBaoP(9)
		DiemBaoP(1) = DiemBaoP(10)

		i = i + 1
	Loop Until IsEmpty(.Offset(i, 0))
End With
AcadApp.ZoomAll
'Xoa bo bien doi tuong
Set AcadApp = Nothing
Set AcadMo = Nothing
Set AcadUt = Nothing
End Sub

 

Trong AutoCad

 

Public ExcelApp As Excel.Application
Public Const Tenfile = "D:\Khoahoc2008\Hinhtru.xls"

Sub VeHinhTru_AutoCad()
Dim i As Integer
Dim AcadMo As AcadModelSpace
Dim AcadUt As AcadUtility
Dim DiemDauP As Variant		     'Diem dau tien de ve
Dim DiemBaoP(0 To 11) As Double     'Diem bao phan to mat cat
'Khai bao ghi ky hieu Ten lop
Dim GhiTenlopP(0 To 2) As Double
Dim Tenlop As String
Dim TenlopT As AcadText
'Khai bao ghi do sau lop
Dim GhiDosauP(0 To 2) As Double
Dim DosauT As AcadText
'Khai bao To mat cat
Dim MatcatH As AcadHatch
Dim VongbaoPL(0) As AcadPolyline
'Khai bao noi dung Hinh tru
Dim HinhTruP(0 To 2) As Double
Dim HinhTruT As AcadText
'Khai bao ty le dung Hinh tru
Dim TLdung As Single
Dim TLdungP(0 To 2) As Double
Dim TLdungT As AcadText
'Khai bao chieu rong cua phan To ky hieu dia tang va Pi
Const Chieurong = 10:  Const Pi = 3.14159
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Khoi dong Excel
Call KhoidongExcel
TLdung = Val(ExcelApp.Sheets("Khai bao").Range("J3"))
'Thiet lap font ".VnArial" cho kieu "Standard"
Set TxtStyleObj = ActiveDocument.TextStyles.Item("Standard")
	TxtStyleObj.SetFont ".VnArial", False, False, 0, 34
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set AcadMo = ActiveDocument.ModelSpace
Set AcadUt = ActiveDocument.Utility
DiemDauP = AcadUt.GetPoint(, "Vao vi tri dau tien:")
'Ghi noi dung ten Hinh tru va Ty le dung
HinhTruP(0) = DiemDauP(0) + 8
HinhTruP(1) = DiemDauP(1) + 4
Set HinhTruT = AcadMo.AddText("HINH TRU HO KHOAN", HinhTruP, 1.5)
TLdungP(0) = HinhTruP(0) + 5
TLdungP(1) = HinhTruP(1) - 2.5
Set TLdungT = AcadMo.AddText("Tû lÖ ®øng: 1/" & TLdung, TLdungP, 1)
	TLdungT.ObliqueAngle = 0.15
DiemBaoP(0) = DiemDauP(0)
DiemBaoP(1) = DiemDauP(1)

With ExcelApp.Worksheets("Khai bao").Range("B2")

	'Tao vong lap qua tung diem
	i = 1
	Do
		'Xac dinh do chenh sau giua cac lop dat
		Chenhsau = (.Offset(i - 1, 1) - .Offset(i, 1)) * 1000 / TLdung
		'Xac dinh cac diem bao va ve duong Polyline
		DiemBaoP(3) = DiemBaoP(0) + Chieurong: DiemBaoP(4) = DiemBaoP(1)
		DiemBaoP(6) = DiemBaoP(3): DiemBaoP(7) = DiemBaoP(4) + Chenhsau
		DiemBaoP(9) = DiemBaoP(6) - Chieurong: DiemBaoP(10) = DiemBaoP(7)
		Set VongbaoPL(0) = AcadMo.AddPolyline(DiemBaoP)
			VongbaoPL(0).Closed = True  'Kep kin duong Polyline
			VongbaoPL(0).color = acRed
		'Ghi ten cac lop dat
		GhiTenlopP(0) = DiemBaoP(3) + 2
		GhiTenlopP(1) = DiemBaoP(4) + Chenhsau / 2
		Tenlop = "Líp " & .Offset(i, 0) & ": " & .Offset(i, 2)
		Set TenlopT = AcadMo.AddText(Tenlop, GhiTenlopP, 0.8)
		'Ghi do sau lop
		GhiDosauP(0) = DiemBaoP(6) + 0.5
		GhiDosauP(1) = DiemBaoP(7)
		Set DosauT = AcadMo.AddText(FormatNumber(.Offset(i, 1), 1), GhiDosauP, 1)
			DosauT.color = acRed
		'To ky hieu mat cat dia tang
		Set MatcatH = AcadMo.AddHatch(1, .Offset(i, 4), True)
			MatcatH.PatternScale = .Offset(i, 5)
			MatcatH.PatternAngle = .Offset(i, 6) * Pi / 180
			MatcatH.AppendOuterLoop (VongbaoPL)
			MatcatH.Evaluate: MatcatH.Update
		'Gan diem de sang lop moi
		DiemBaoP(0) = DiemBaoP(9)
		DiemBaoP(1) = DiemBaoP(10)

		i = i + 1
	Loop Until IsEmpty(.Offset(i, 0))
End With
ZoomAll
'Xoa bo bien doi tuong
Set ExcelApp = Nothing
Set AcadMo = Nothing
Set AcadUt = Nothing

End Sub

 

Các bạn sẽ thấy hai thủ tục trên giống nhau như 2 chị em sinh đôi! Chính vì vậy bạn sẽ không bị bỡ ngỡ khi chuyển đổi môi trường lập trình VBA

 

 

Hinh12.jpg

Hình 12: Kết quả vẽ hình trụ hố khoan và một số đối tượng vẽ chính

 

 

Một số đối tượng chính trong thủ tục trên được mô tả trong kết quả vẽ hình trụ hố khoan tại hình 12. Trong đó, những đối tượng trong AutoCad quy ước có đuôi chữ hoa P là point, PL là polyline, T là text, L là line,...

 

3. Kết luận

 

- Chức năng Automation giúp chúng ta xây dựng các chương trình có khả năng tự động hoá trao đổi dữ liệu giữa các môi trường khác nhau. Sự kết hợp giữa Excel, AutoCad cùng với ngôn ngữ lập trình VBA tích hợp bên trong có thể giải quyết được nhiều bài toán phức tạp khác nhau trong lĩnh vực kỹ thuật.

- Giống như VB6, VBA là ngôn ngữ lập trình tiện dụng phát triển trong nhiều ứng dụng, có khả năng ứng dụng mạnh mẽ trong nhiều ngành nghề, cần được quan tâm đúng mức trong việc dạy và học tin học ứng dụng không chuyên trong các trường Đại học.

 

sao hình ảnh lỗi hết vậy bạn. t chẳng xem dc gì cả. hix

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ôi có một số code về vba có thể liên hệ giữa autocad và excel. Nếu anh em nào muốn có thể liên lạc với tôi tôi sẽ cho :).

yahoo: phambavinh_ht

email: bavinh.bavinh@gmail.com

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

cho mình hỏi. làm thế nào để lấy dữ liệu từ Excel để xử lý trong CAD

mình ví dụ thế này: trong VBA CAD có các textbox là L1, L2, L3

trong excel có các cột L1, L2, L3 ở các vị trí A1, B1, C1 tương ứng. vậy làm thế nào để CAD là để gán giá trị từ excel cho CAD. 

chương trình trong CAD có thể đơn giản làm 1 cái msgbox hiển thị giá trị trong cột L1,L2, L3 ....

 

bạn nào biết chỉ giúp nhé. thanks

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

cho mình hỏi. làm thế nào để lấy dữ liệu từ Excel để xử lý trong CAD

mình ví dụ thế này: trong VBA CAD có các textbox là L1, L2, L3

trong excel có các cột L1, L2, L3 ở các vị trí A1, B1, C1 tương ứng. vậy làm thế nào để CAD là để gán giá trị từ excel cho CAD. 

chương trình trong CAD có thể đơn giản làm 1 cái msgbox hiển thị giá trị trong cột L1,L2, L3 ....

 

bạn nào biết chỉ giúp nhé. thanks

Bạn phải kết nối giữa AutoCad và Excel lại với nhau thì mới lấy dữ liệu qua lại với nhau dc.

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

Mình cần học lớp lập trình ứng dụng VBA để lien kết CAD và exell, bạn nào biết ở đâu mở lớp xin chỉ giúp mình.

Nếu cần thì mình dạy online cho bạn nhé.

Add skype mình: dinhvantrang73 hoặc inbox mail: dinhvantrang73@gmail.com

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

Rất vui là nội dung kết nối này đã được nhiều bạn áp dụng trong việc kết nối giữa 2 môi trường Excel và AutoCad. Nhờ khả năng này mà công việc được tự động hóa với kết quả chính xác cao.

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


×