Lập trình VBA trong AutoCAD được sử dụng rộng rãi từ AutoCAD r14

Trang 1

1 Lập trình VBA trong AutoCAD được sử dụng rộng rãi từ AutoCAD R14 (năm 1997), lúc đó các Fan hâm mộ AutoCAD ở Việt Nam đang vui mừng được sử dụng AutoCAD trong môi trường Windows (AutoCAD R13 màn hình mặc định màu xám và sử dụng không thân thiện lắm) và AutoLISP đang được ưa chuộng nên ít người tìm hiểu về VBA (Visual Basic for Application) trong môi trường AutoCAD, năm 1998 nhiều đơn vị tư vấn vẫn còn vẽ tay hoặc sử dụng AutoCAD R12 chạy trên môi trường DOS

Lập trình VBA trong AutoCAD không hề đơn giản, để bắt đầu cũng cần kiến thức cơ bản về VBA, nhưng nếu làm chủ được VBA bạn sẽ tạo ra những tiện ích trợ giúp cho công việc thiết kế cũng như tạo ra những phần mềm ứng dụng thú vị

Bài 1: Kết hợp AutoLISP và VBA tạo ra ứng dụng đơn giản đầu tiên vẽ hình vuông khi cho biết 1 điểm và chiều dài cạnh

1 Tạo lệnh tắt:

- Tại màn hình Desktop bấm phải chuột, chọn New, Text Document

- Nhập tên file bất kỳ, bấm kép mở file

- Nhập dòng lệnh sau (có thể tải file ở dưới):

(Defun C:Vhv() (Command "Vbarun" "Vhv") (princ))

- Chọn Menu File, Save As, đặt tên file là 1_Vhv.lsp

- Như vậy bạn đã có Lệnh tắt Vhv, chạy 1 ứng dụng VBA tên là Vhv (vẽ hình vuông)

2 File 1_Vehinhvuong.dvb:

- Đây là file chứa nội dung lập trình VBA

- Có thể copy ra file khác và viết thêm ứng dụng vào trong file

Tải thư mục VBA đính kèm gồm 2 file 1_Vhv.lsp và 1_Vehinhvuong.dvb

Tải xong copy thư mục vào ổ C:\

3 Chạy ứng dụng:

- Khởi động AutoCAD

- Gõ lệnh AP

- Chọn 2 file để load (hoặc bấm kép vào từng file): 1_Vhv.lsp và 1_Vehinhvuong.dvb

- Nhập lệnh: Vhv

- Chọn 1 điểm

- Nhập chiều dài cạnh, ví dụ bằng 50, kết quả như hình dưới

Trang 2

Đây là nội dung toàn bộ file VBA:

-Trong AutoCAD nhấn Alt+F11 để xem

'**************************************

'VE HINH VUONG

'Design by LDT2007 - Tel : 091.304.9779

'**************************************

Public Sub Vhv()

On Error GoTo Err_Vhv

Dim P01 As Variant

Dim D1(0 To 2) As Double

Dim L1 As AcadLine

Dim L2 As AcadLine

Dim L3 As AcadLine

Dim L4 As AcadLine

P01 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ") Dim Canh As Double

Canh = ThisDrawing.Utility.GetDistance(, "Nhap chieu dai canh:") D1(0) = P01(0): D1(1) = P01(1): D1(2) = 0

Trang 3

D2(0) = P01(0) + Canh: D2(1) = P01(1): D2(2) = 0

D3(0) = P01(0) + Canh: D3(1) = P01(1) + Canh: D3(2) = 0

D4(0) = P01(0): D4(1) = P01(1) + Canh: D4(2) = 0

Set L1 = ThisDrawing.ModelSpace.AddLine(D1, D2)

'L1.Layer = "Tuong"

'L2.Layer = "Tuong"

Exit_Vhv:

Exit Sub

Err_Vhv:

MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao"

Resume Exit_Vhv

End Sub

Tập tin đính kèm

o VBA.rar (16.0 KB, 561 xem) Sửa lần cuối bởi ldt2007; 11-12-2010 lúc 10:33 PM.

2 Diễn đàn và thành viên sau cảm ơn bạn ldt2007 về bài viết rất hữu ích này:

gako (31-10-2012)

3 11-12-2010, 05:05 PM#2

ldt2007

Thành viên rất tích cực

Ngày tham gia

Aug 2008

Bài viết

103

Thanks

0

Thanked 9 Times in 9 Posts

Giải thích các dòng lệnh, mục đích:

- Để tìm hiểu cơ chế làm việc của VBA

- Làm quen với ngôn ngữ lập trình

- Để tiếp tục viết các ứng dụng cơ bản khác

- Từ ứng dụng cơ bản => ứng dụng phức tạp hơn hỗ trợ cho công việc

'**************************************

'VE HINH VUONG

'Design by LDT2007 - Tel : 091.304.9779

'**************************************

Vài dòng ghi chú, để viết ghi chú trước dòng phải có dấu nháy đơn (')

Public Sub Vhv()

Tên của hàm con, có thể đặt Public Sub = Public Function để hàm hoạt động rộng rãi hơn

Vhv() tên hàm và đối số ở trong ngoặc nếu có

On Error GoTo Err_Vhv

Gặp lỗi thì chạy đến Err_Vhv

Dim P01 As Variant

Đặt điểm P01 là một biến

Khai báo các điểm D1, 2, 3, 4:

Ta có D1(0) là giá trị tọa độ x của điểm D1

Ta có D1(1) là giá trị tọa độ y của điểm D1

Ta có D1(2) là giá trị tọa độ z của điểm D1, tương tự với các điểm khác

Dim L1 As AcadLine

Dim L2 As AcadLine

Dim L3 As AcadLine

Trang 4

Dim L4 As AcadLine

Khai báo L1, 2, 3, 4 là các đường thẳng

P01 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ")

Đây là thủ tục để lấy giá trị tọa độ của điểm P01, dòng nhắc trong dấu ngoặc sẽ xuất hiện trong AutoCAD Dim Canh As Double

Đặt Canh là tên 1 biến số

Canh = ThisDrawing.Utility.GetDistance(, "Nhap chieu dai canh:")

Đây là thủ tục để gán giá trị nhập vào một biến, dòng nhắc trong dấu ngoặc sẽ xuất hiện trong AutoCAD D1(0) = P01(0): D1(1) = P01(1): D1(2) = 0

Lấy tọa độ x, y, z của điểm D1 căn cứ vào điểm P01

Dồn 3 dòng lệnh trên 1 dòng thì cách nhau bởi dấu 2 chấm (: )

D2(0) = P01(0) + Canh: D2(1) = P01(1): D2(2) = 0

Lấy tọa độ x, y, z của điểm D2 căn cứ vào điểm P01

D02(0): tọa độ x của điểm D2

= P01(0) + Canh: bằng tọa độ x của điểm P01 cộng Canh

D3(0) = P01(0) + Canh: D3(1) = P01(1) + Canh: D3(2) = 0

D4(0) = P01(0): D4(1) = P01(1) + Canh: D4(2) = 0

Vẽ đường thẳng L1 nối từ điểm D1 đến D2

'L1.Layer = "Tuong"

'L2.Layer = "Tuong"

Nếu trong file CAD của bạn có lớp tường thì đổi lớp cho đối tượng bằng cách trên

Exit_Vhv:

Exit Sub

Dòng kết thúc hàm con

Err_Vhv:

Hiển thị thông báo khi gặp lỗi

Resume Exit_Vhv

Trở lại Exit_Vhv để kết thúc

End Sub

Kết thúc hàm con

Sửa lần cuối bởi ldt2007; 11-12-2010 lúc 05:13 PM.

gako (31-10-2012)

5 16-12-2010, 04:39 AM#3

ldt2007

Ngày tham gia

Aug 2008

Bài viết

103

Thanks

0

Bài 2: Vẽ hình vuông, hình tròn, cung như hình dưới trái

khi cho biết điểm P1 và chiều dài cạnh là a

Trang 5

1 Tạo lệnh tắt:

- Mở file 1_Vhv.lsp (đã tải ở bài trước).

- Chọn Menu File, Save As đặt tên mới là 2_Vhvt.lsp

- Nhập dòng lệnh sau (có thể tải file ở dưới):

(Defun C:Vhvt() (Command "Vbarun" "Vhvt") (princ))

- Như vậy bạn đã có thêm Lệnh tắt Vhvt, chạy 1 ứng dụng VBA tên là Vhvt (vẽ hình vuông tròn)

2 File 2_Vehinhvuongtron.dvb:

Tải file đính kèm gồm 2 file 2_Vhvt.lsp và 2_Vehinhvuongtron.dvb

Tải xong copy thư mục vào ổ C:\VBA\

3 Chạy ứng dụng:

- Gõ lệnh AP

- Chọn 2 file để load (hoặc bấm kép vào từng file): 2_Vhvt.lsp và 2_Vehinhvuongtron.dvb

- Nhập lệnh: Vhvt

- Chọn 1 điểm

- Nhập chiều dài cạnh, ví dụ bằng 50, kết quả như hình trên phải

Nội dung file VBA

Trong AutoCAD nhấn Alt+F11 để xem

'**************************************

'VE HINH VUONG TRON

'Design by LDT2007 - Tel : 091.304.9779

'**************************************

Public Sub Vhvt()

On Error GoTo Err_Vhvt

Dim Pi

Trang 6

Pi = 4 * Atn(1)

Dim P1 As Variant

Dim Canh As Double

Dim PL01 As AcadPolyline

Dim P01(11) As Double

Dim L01 As AcadLine, L02 As AcadLine

Dim D01(0 To 2) As Double, D02(0 To 2) As Double, D03(0 To 2) As Double, D04(0 To 2) As Double P01(0) = P1(0) - Canh / 2: P01(1) = P1(1) - Canh / 2

P01(3) = P1(0) + Canh / 2: P01(4) = P1(1) - Canh / 2

P01(6) = P1(0) + Canh / 2: P01(7) = P1(1) + Canh / 2

P01(9) = P1(0) - Canh / 2: P01(10) = P1(1) + Canh / 2

'Ve Hinh vuong polyline

Set PL01 = ThisDrawing.ModelSpace.AddPolyline(P01)

PL01.Closed = True

Dim PL02 As Variant

'Ve Hinh vuong polyline offset

PL02 = PL01.Offset(Canh / 2)

'PL01.Layer = "Tuong"

D01(0) = P1(0): D01(1) = P1(1) - Canh / 4

D02(0) = P1(0) + Canh / 4: D02(1) = P1(1)

D03(0) = P1(0): D03(1) = P1(1) + Canh / 4

D04(0) = P1(0) - Canh / 4: D04(1) = P1(1)

'Ve Duong thang

Dim A01 As AcadArc, A02 As AcadArc

Dim Tam(0 To 2) As Double, Bankinh As Double, Gocdau As Double, Goccuoi As Double

Tam(0) = P1(0): Tam(1) = P1(1)

Bankinh = Canh / 4

Gocdau = 90 * Pi / 180#

Goccuoi = 180 * Pi / 180#

'Ve Cung 1

Set A01 = ThisDrawing.ModelSpace.AddArc(Tam, Bankinh, Gocdau, Goccuoi)

Gocdau = 270 * Pi / 180#

Goccuoi = 360 * Pi / 180#

'Ve Cung 2

Dim C01 As AcadCircle

'Ve Hinh tron

Set C01 = ThisDrawing.ModelSpace.AddCircle(Tam, Canh)

Exit_Vhvt:

Exit Sub

Err_Vhvt:

Resume Exit_Vhvt

End Sub

Tập tin đính kèm

o VBA2.rar (17.8 KB, 283 xem)

Sửa lần cuối bởi ldt2007; 16-12-2010 lúc 11:16 AM Lý do: Update Picture

gako (31-10-2012)

7 18-12-2010, 09:56 PM#4

rongthucgiac

Trang 7

Ngày tham gia

Dec 2010

Bài viết

1

Thanks

0

Cảm ơn bạn nhiều, chuẩn bị học cái này

patio chairs

Cheap Viagra

8 19-12-2010, 03:34 PM#5

ldt2007

Ngày tham gia

Aug 2008

Bài viết

103

Thanks

0

Giải thích các dòng lệnh Bài 2:

Public Sub Vhvt()

Hàm Vhvt (vẽ hình vuông tròn)

On Error GoTo Err_Vhvt

Gặp lỗi thì chạy đến Err_Vhvt

Dim Pi

Pi = 4 * Atn(1)

Hai dòng trên lấy giá trị chính xác của Pi bởi: 180° = Pi radians, tan(45°)=1, arctan(1)= Pi radians/4 => Pi = 4 * Atn(1) Trong VBA cho AutoCAD hàm arctan là Atn(), trong Exel hàm arctan là Atan()

Có thể thay 2 dòng trên bằng 1 dòng bởi Pi là một hằng thay cho 1 biến: Const Pi = 4 * Atn(1)

Dim P1 As Variant

Đặt điểm P1 là một biến

Dim Canh As Double

Đặt Canh là tên 1 biến số

Đây là thủ tục để lấy giá trị tọa độ của điểm P1, dòng nhắc trong dấu ngoặc kép (") sẽ xuất hiện trong AutoCAD

Đây là thủ tục để gán giá trị nhập vào một biến, dòng nhắc trong dấu ngoặc kép (") sẽ xuất hiện trong AutoCAD

Dim PL01 As AcadPolyline

Khai báo PL01 là đường polyline

Dim P01(11) As Double

Khai báo nhóm điểm P01 phục vụ vẽ đường polyline

Dim L01 As AcadLine, L02 As AcadLine

Khai báo L01, 02 là các đường thẳng, ghép 2 dòng khai báo trên 1 dòng phân cách bởi dấu phẩy (,)

Dim D01(0 To 2) As Double, D02(0 To 2) As Double, D03(0 To 2) As Double, D04(0 To 2) As Double

Khai báo D01, 02, 03, 04 là các điểm, ghép 4 dòng khai báo trên 1 dòng phân cách bởi dấu phẩy (,)

Ta có D01(0) là giá trị tọa độ x của điểm D01

Ta có D01(1) là giá trị tọa độ y của điểm D01

Ta có D01(2) là giá trị tọa độ z của điểm D01, tương tự với các điểm khác

P01(0) = P1(0) - Canh / 2: P01(1) = P1(1) - Canh / 2

P01(3) = P1(0) + Canh / 2: P01(4) = P1(1) - Canh / 2

P01(6) = P1(0) + Canh / 2: P01(7) = P1(1) + Canh / 2

Trang 8

P01(9) = P1(0) - Canh / 2: P01(10) = P1(1) + Canh / 2

- Xác định toạ độ nhóm điểm P01 Ở đây đã bỏ các toạ độ z của P01: P01(2), P01(5), P01(8) bởi ta đang vẽ trên mặt phẳng 2D

'Ve Hinh vuong polyline

Set PL01 = ThisDrawing.ModelSpace.AddPolyline(P01)

PL01.Closed = True

- Vẽ đường thẳng polyline nối các điểm trong nhóm điểm và closed lại

Dim PL02 As Variant

- Đặt đối tượng PL02 là một biến

'Ve Hinh vuong polyline offset

PL02 = PL01.Offset(Canh / 2)

Vẽ hình vuông thứ 2 bằng cách offset hình vuông thứ nhất, giá trị offset dương là offset ra, âm là offset vào Đối với đường thẳng giá trị offset âm (trừ), dương (cộng) căn cứ vào toạ độ trục x, y của đối tượng gốc

'PL01.Layer = "Tuong"

Đổi lớp cho hình vuông 1 nếu bản vẽ có lớp Tường

D01(0) = P1(0): D01(1) = P1(1) - Canh / 4

D02(0) = P1(0) + Canh / 4: D02(1) = P1(1)

D03(0) = P1(0): D03(1) = P1(1) + Canh / 4

D04(0) = P1(0) - Canh / 4: D04(1) = P1(1)

Xác định toạ độ 4 điểm D01, 02, 03, 04 căn cứ vào điểm P1

'Ve Duong thang

- Vẽ đường thẳng L01 nối từ điểm D01 đến D03

- Vẽ đường thẳng L02 nối từ điểm D02 đến D04

Dim A01 As AcadArc, A02 As AcadArc

Khai báo A01, 02 là các cung

Dim Tam(0 To 2) As Double, Bankinh As Double, Gocdau As Double, Goccuoi As Double

Khai báo tâm, bán kính, góc đầu, góc cuối của cung

Tam(0) = P1(0): Tam(1) = P1(1)

Lấy toạ độ x, y Tam theo P1 toại độ z bằng 0

Bankinh = Canh / 4

Gocdau = 90 * Pi / 180#

Goccuoi = 180 * Pi / 180#

Góc trong AutoCAD tính bằng radians 90° đổi ra radians = 90*Pi/180# (dấu # thể hiện là con số)

'Ve Cung 1

Thủ tục để vẽ cung A01

Gocdau = 270 * Pi / 180#

Goccuoi = 360 * Pi / 180#

'Ve Cung 2

Thủ tục để vẽ cung A02

Dim C01 As AcadCircle

Khai báo C01 là đường tròn

'Ve Hinh tron

Set C01 = ThisDrawing.ModelSpace.AddCircle(Tam, Canh)

Thủ thục vẽ đường tròn khi biết tâm và bán kính

Exit_Vhvt:

Exit Sub

Dòng kết thúc hàm con

Err_Vhvt:

Hiển thị thông báo khi gặp lỗi

Resume Exit_Vhvt

Trở lại Exit_Vhvt để kết thúc

End Sub

Kết thúc hàm con

- Sau 2 bài ta đã vẽ được đường thẳng, cung, đường tròn, hình vuông với "vốn liếng" như vậy có thể áp dụng vào AutoCAD được rồi (bản vẽ AutoCAD cũng chỉ có đường thẳng và cong )

- Trình tự vẽ đối tượng:

1 Khai báo đối tượng bắt đầu bởi Dim

2 Xác định toạ độ đối tượng bằng cách lấy toạ độ 1 điểm gốc nào đó

Trang 9

3 Xác định các biến khác của đối tượng

4 Vẽ, offset, copy, mirror, array đối tượng

9 03-01-2011, 03:39 AM#6

ldt2007

Ngày tham gia

Aug 2008

Bài viết

103

Thanks

0

Bài 3: Vẽ trục trên mặt bằng

- Ta có hình vẽ bên trái và kết quả bên phải

1 Tạo lệnh tắt bằng file LSP, xem bài 1:

- Tên file là 3_Vtr.lsp, bao gồm 2 lệnh tắt:

- Vtr1: Vẽ trục bắt đầu từ 1, 2, 3

- VtrA: Vẽ trục bắt đầu từ A, rồi B, C Z

- Nội dung file LSP như sau (có thể tải file đính kèm)

;;; Ve truc

(Defun C:Vtr1() (Command "Vbarun" "Vtr1") (princ))

(Defun C:VtrA() (Command "Vbarun" "VtrA") (princ))

- Tải file đính kèm gồm 2 file 3_Vtr.lsp và 3_Vetruc.dvb

- Tải xong copy thư mục VBA vào ổ C:\

Trang 10

3 Chạy ứng dụng:

- Gõ lệnh AP

- Chọn 2 file để load (hoặc bấm kép vào từng file): 3_Vtr.lsp và 3_Vetruc.dvb

- Nhập lệnh: Vtr1 vẽ tên trục bắt đầu bởi số 1, 2, 3

- Chọn 1 điểm P1, điểm P1 chọn chính xác vào đường gióng kích thước

- Chọn các điểm khác tại đường kích thước hoặc thậm chí tại đường tim cũng được Các trục sau sẽ lấy tọa độ y của điểm đầu P1

- Nhập lệnh: VtrA vẽ tên trục bắt đầu bởi số A, B, C Z

- Chọn 1 điểm P1, điểm P1 chọn chính xác vào đường gióng kích thước

- Chọn các điểm khác tại đường kích thước hoặc thậm chí tại đường tim cũng được Các trục sau sẽ lấy tọa độ x của điểm đầu P1 Tập tin đính kèm

o VBA3.rar (18.0 KB, 297 xem)

10 03-01-2011, 03:57 AM#7

ldt2007

Ngày tham gia

Aug 2008

Bài viết

103

Thanks

0

Nội dung file lập trình VBA Bài 3:

- Lưu ý nếu 1 đơn vị vẽ AutoCAD của bạn = 1mm thì sửa dòng lệnh:

Const Tile = 1 >>>> bằng >>>> Const Tile = 1000

- Còn đơn vị chúng tôi hay dùng: 1đơn vị AutoCAD = 1m (dùng trong quy hoạch - kiến trúc)

- Vẽ trục bao gồm 1 hình tròn d= 0,35cm và Text cao 0,5cm đơn giản nhưng viết lập trình đến 30 dòng

- Ứng dụng đã áp dụng được vào công việc thực tế và viết Code đã khó hơn Ta tìm hiểu kỹ hơn các dòng lệnh vào bài sau

'*************************************************

'VE TRUC

'Design by LDT2007 - Tel : 091.304.9779 - NEW YEAR 2011!

'*************************************************

Public Sub Vtr1()

On Error GoTo Err_Vtr1

Const Tile = 1

'neu 1 don vi ve = 1mm thi tile = 1000

'tile = 1000

Dim i

i = 0

Dim P1 As Variant, P2 As Variant

P1 = ThisDrawing.Utility.GetPoint(, "Chon diem dat ten truc: ")

Dim Tam(0 To 2) As Double

Dim C01 As AcadCircle, Bankinh As Double, T01 As AcadText

Do

i = i + 1

If i = 1 Then

Tam(0) = P1(0): Tam(1) = P1(1) + 0.7 * Tile

Else

Tam(1) = P1(1) + 0.7 * Tile

P2 = ThisDrawing.Utility.GetPoint(, "Chon diem dat ten truc: ")

Tam(0) = P2(0)

End If

Bankinh = 0.35 * Tile

Set C01 = ThisDrawing.ModelSpace.AddCircle(Tam, Bankinh)

C01.Layer = "0"

Set T01 = ThisDrawing.ModelSpace.AddText(i, Tam, 0.5 * Tile)

Định dạng
Số trang	12
Dung lượng	366,5 KB