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

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.
Đâ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 D2(0 To 2) As Double
Dim D3(0 To 2) As Double
Dim D4(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
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)
Set L2 = ThisDrawing.ModelSpace.AddLine(D2, D3)
Set L3 = ThisDrawing.ModelSpace.AddLine(D3, D4)
Set L4 = ThisDrawing.ModelSpace.AddLine(D4, D1)
'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
Dim D1(0 To 2) As Double
Dim D2(0 To 2) As Double
Dim D3(0 To 2) As Double
Dim D4(0 To 2) As Double
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
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
Set L1 = ThisDrawing.ModelSpace.AddLine(D1, D2)
Vẽ đường thẳng L1 nối từ điểm D1 đến D2
Set L2 = ThisDrawing.ModelSpace.AddLine(D2, D3)
Vẽ đường thẳng L2 nối từ điểm D2 đến D3
Set L3 = ThisDrawing.ModelSpace.AddLine(D3, D4)
Vẽ đường thẳng L3 nối từ điểm D3 đến D4
Set L4 = ThisDrawing.ModelSpace.AddLine(D4, D1)
Vẽ đường thẳng L4 nối từ điểm D4 đến D1
'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:
MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao"
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.

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

5. 16-12-2010, 04:39 AM#3
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
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.
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:
- Đây là file chứa nội dung lập trình VBA.
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:
- Khởi động AutoCAD.
- 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
Pi = 4 * Atn(1)
Dim P1 As Variant
Dim Canh As Double
P1 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ")
Canh = ThisDrawing.Utility.GetDistance(, "Nhap chieu dai canh:")
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
Set L01 = ThisDrawing.ModelSpace.AddLine(D01, D03)
Set L02 = ThisDrawing.ModelSpace.AddLine(D02, D04)
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
Set A02 = ThisDrawing.ModelSpace.AddArc(Tam, Bankinh, Gocdau, Goccuoi)
Dim C01 As AcadCircle
'Ve Hinh tron
Set C01 = ThisDrawing.ModelSpace.AddCircle(Tam, Canh)
Exit_Vhvt:
Exit Sub
Err_Vhvt:
MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao"
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

6. 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)
7. 18-12-2010, 09:56 PM#4
rongthucgiac
Thành viên dự bị
Ngày tham gia
Dec 2010
Bài viết
1
Thanks
0
Thanked 0 Times in 0 Posts
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
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 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ố
P1 = ThisDrawing.Utility.GetPoint(, "Chon mot diem: ")
Đâ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
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 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
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
Set L01 = ThisDrawing.ModelSpace.AddLine(D01, D03)
- Vẽ đường thẳng L01 nối từ điểm D01 đến D03
Set L02 = ThisDrawing.ModelSpace.AddLine(D02, D04)
- 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
Set A01 = ThisDrawing.ModelSpace.AddArc(Tam, Bankinh, Gocdau, Goccuoi)
Thủ tục để vẽ cung A01
Gocdau = 270 * Pi / 180#
Goccuoi = 360 * Pi / 180#
'Ve Cung 2
Set A02 = ThisDrawing.ModelSpace.AddArc(Tam, Bankinh, Gocdau, Goccuoi)
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:
MsgBox "Loi, khong thuc hien duoc!", vbCritical, "Thong bao"
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 đó

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
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
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))
2. File lập trình DVB tên là 3_VeTruc.dvb (tải ở dưới)
- Đây là file chứa nội dung lập trình VBA.
- 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:\
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): 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
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
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)
T01.Alignment = acAlignmentMiddleCenter
T01.TextAlignmentPoint = Tam
Loop
Exit_Vtr1:
Exit Sub
Err_Vtr1:

'MsgBox "OK!", vbCritical, "Thong bao"
Resume Exit_Vtr1
End Sub
Public Sub VtrA()
On Error GoTo Err_VtrA
Const Tile = 1
'neu 1 don vi ve = 1mm thi tile = 1000
'tile = 1000
Dim i
i = 64
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 = 65 Then
Tam(0) = P1(0) - 0.7 * Tile: Tam(1) = P1(1)
Else
Tam(0) = P1(0) - 0.7 * Tile
P2 = ThisDrawing.Utility.GetPoint(, "Chon diem dat ten truc: ")
Tam(1) = P2(1)
End If
Bankinh = 0.35 * Tile
Set C01 = ThisDrawing.ModelSpace.AddCircle(Tam, Bankinh)
C01.Layer = "0"
Set T01 = ThisDrawing.ModelSpace.AddText(Chr(i), Tam, 0.5 * Tile)
T01.Alignment = acAlignmentMiddleCenter
T01.TextAlignmentPoint = Tam
Loop

Exit_VtrA:
Exit Sub
Err_VtrA:
'MsgBox "OK!", vbCritical, "Thong bao"
Resume Exit_VtrA
End Sub
Một số thủ tục VBA trong AutoCAD để tạo bản vẽ
Xin giới thiệu với các bạn một số ví dụ về thủ tục VBA phục vụ tạo bản vẽ trong AutoCAD.
1. Thủ tục tạo các Layers
Sub TaoLayers()
Dim layerObj As AcadLayer
Dim layertypeName As String
layertypeName = "ACAD_ISO03W1000"
Set layerObj = Thisdrawing.Layers.Add("netthuong") 'Tạo layer "netthuong"
layerObj.color = acBlue 'chọn màu nét của Layer "netthuong"
On Error Resume Next 'nếu kiểu nét ACAD_ISO03W1000 đã được load rồi sẽ phát sinh lỗi nên dùng câu lệnh này để loại bỏ lỗi phát sinh đó
Thisdrawing.Linetypes.Load layertypeName, "acad.lin" 'Load kiểu nét ACAD_ISO03W1000 để sẵn sàng các layers có thể sử dụng
Set layerObj = Thisdrawing.Layers.Add("netdut") 'tạo layer "netdut"
layerObj.color = acRed
layerObj.Linetype = linetypeName 'chọn kiểu net cho layer "netdut"
End Sub
2. Thủ tục tạo Dimension Style
Sub TaoDimStyle()
Dim DimStyleObj As AcadDimStyle
Set DimStyleObj = ThisDrawing.DimStyles.Add("kichthuoc") 'Tạo Dimension Style "kichthuoc"
'tiếp theo hiệu chỉnh một số yếu tố liên quan đến đường ghi kích thước của Dim Style hiện hành
ThisDrawing.SetVariable. "DIMASZ", 80
ThisDrawing.SetVariable. "DIMDEC", 0
ThisDrawing.SetVariable. "DIMTXT", 100
DimStyleObj.CopyFrom ThisDrawing 'Copy Dim Style hiện hành vào Dim Style "kichthuoc"

ThisDrawing.ActiveDimStyle = DimStyleObj 'Chuyển Dim Style hiện hành là "kichthuoc"
End Sub
3. Thủ tục tạo Text Style
Sub TaoTextStyle
Dim TextStyleObj As AcadTextStyle
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuhoa")
TextStyleObj.SetFont ".VnArialH", True, False, 0, 34
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuthuong")
TextStyleObj.SetFont ".VnArial", True, False, 0, 34
End Sub