III LẬP TRÌNH TẠO MỘT KHUNG TÊN
Vẽ khung tên bản vẽ
Tạo khung tên bản vẽ bằng lập trình VBA
Sử dụng VBA để vẽ khung tên bản vẽ. Tạo một giao diện như sau
Vơi đoạn mã viết trong VBA như sau:
Dim i As Integer
Dim mt(0 To 6) As String
mt(6) = "TRUONG " & UCase(CStr(truong)): mt(5) = "LOP: " & CStr(lop): mt(4) = "NGUOI VE: " & CStr(nguoive): mt(3) = "MA SV: " & CStr(masv): mt(2) = CStr(ngayve)
mt(1) = "SO HIEU: " & CStr(sohieu): mt(0) = CStr(ngayht):
dc(0) = 170 dc(1) = 27 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(6)) ZoomAll textObj.Height = 5 textObj.Update dc(0) = 170 dc(1) = 14 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(4)) ZoomAll textObj.Height = 3 textObj.Update dc(0) = 145 dc(1) = 29 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, "NGAY VE") ZoomAll textObj.Height = 3 textObj.Update dc(0) = 143 dc(1) = 23 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(2)) ZoomAll
textObj.Height = 3 textObj.Update dc(0) = 145 dc(1) = 13 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, "NGAY HT") ZoomAll textObj.Height = 3 textObj.Update dc(0) = 143 dc(1) = 7.5 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(0)) ZoomAll textObj.Height = 3 textObj.Update dc(0) = 251 dc(1) = 13.5 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(3)) ZoomAll textObj.Height = 3 textObj.Update dc(0) = 255 dc(1) = 6.2 dc(2) = 0 Width = 150
dc(0) = 192 dc(1) = 5.8 dc(2) = 0 Width = 150
Set textObj = ThisDrawing.ModelSpace.AddMText(dc, Width, mt(5)) ZoomAll
textObj.Height = 3 textObj.Update
'Ve khung ten
Dim lineObj As AcadLine Dim d(0 To 2) As Double Dim c(0 To 2) As Double
'Ve duong bao khung
d(0) = 0#: d(1) = 0#: d(2) = 0# c(0) = 297#: c(1) = 0#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 297#: d(1) = 0#: d(2) = 0# c(0) = 297#: c(1) = 210#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 297#: d(1) = 210#: d(2) = 0# c(0) = 0#: c(1) = 210#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c) 'lineObj.layer = "tuan"
d(0) = 0#: d(1) = 210#: d(2) = 0# c(0) = 0#: c(1) = 0#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
'Ve khung ten
d(0) = 137#: d(1) = 0#: d(2) = 0# c(0) = 137#: c(1) = 32#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
c(0) = 297#: c(1) = 32#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 169#: d(1) = 0#: d(2) = 0# c(0) = 169#: c(1) = 32#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 169#: d(1) = 8#: d(2) = 0# c(0) = 233#: c(1) = 8#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 233#: d(1) = 0#: d(2) = 0# c(0) = 233#: c(1) = 16#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 233#: d(1) = 8#: d(2) = 0# c(0) = 297#: c(1) = 8#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
d(0) = 137#: d(1) = 16#: d(2) = 0# c(0) = 297#: c(1) = 16#: c(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(d, c)
ZoomAll Unload Me End Sub
Ta khai báo các hộp textbox là tên các nhãn
Nhập trường , lớp , sinh viên thực hiện, mã sinh viên, ngày vẽ ,ngày hoàn thành, số hiệu bản vẽ sau đó nhấn vào vẽ khung tên ta được như hình vẽ sau