Tao menu trong VBA & autocad

Sub AddMenuItemText()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

' Create the new menu
Dim newMenu As AcadPopupMenu
Set newMenu = currMenuGroup.Menus.Add("Text")

' Add a menu item to the new menu
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN AddTextNew" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Add Text", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN AddMTextNew" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Add MText", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MTE" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Edit Text", openMacro)

' Display the menu on the menu bar
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

Code:
Public Sub removeMenu()
'this macro removes the submenu created by the addMenuItem macro
Dim oAcad As AcadApplication
Set oAcad = ThisDrawing.Application
Dim oPopup As AcadPopupMenu
Dim oPopupItem As AcadPopupMenuItem
For Each oPopup In oAcad.MenuBar
If oPopup.TagString = "ID_mnuText" Then
oPopup.RemoveFromMenuBar
oPopup.Delete
End If
Next oPopup
End Sub


Các thủ tục (macro):
Code:

Sub AddTextNew()
Dim textObj As AcadText
Dim textString As String
Dim textHeight As Double
Dim textPoint As Variant
textPoint = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
textHeight = ThisDrawing.Utility.GetReal("Text height: ")
textString = InputBox("Text: ", "Nguyen Van Son")
Set textObj = ThisDrawing.ModelSpace.AddText(textString, textPoint, textHeight)
End Sub

Sub AddMtextNew()
Dim mtextObj As AcadMText
Dim width As Double
Dim MtextPoint As Variant
Dim MtextString As String

MtextPoint = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
MtextString = InputBox("MText: ", "Nguyen Van Son")
width = 100
Set mtextObj = ThisDrawing.ModelSpace.AddMText(MtextPoint, width, MtextString)
'mtextObj.textString = "OK"

End Sub

Public Sub MTE()
On Error Resume Next
' Create the selection set
Dim ssetObj As AcadSelectionSet
Dim text_New As String
Dim str_Name As String

If Not IsNull(ThisDrawing.SelectionSets.Item("Text")) Then
Set ssetObj = ThisDrawing.SelectionSets.Item("Text")
ssetObj.Delete
End If
Set ssetObj = ThisDrawing.SelectionSets.Add("Text")

'str_Name = Hour(Time) & Minute(Time) & Second(Time)
'Set ssetObj = ThisDrawing.SelectionSets.Add(str_Name)

' Add objects to a selection set by prompting user to select on the screen
ssetObj.SelectOnScreen
For i = 0 To ssetObj.Count - 1
If ssetObj.Item(i).ObjectName = "AcDbMText" Or ssetObj.Item(i).ObjectName = "AcDbText" Then
text_New = InputBox("Nhap doan text moi: ", "Nguyen Van Son", ssetObj.Item(i).textString)
ssetObj.Item(i).textString = text_New
ssetObj.Update
End If
Next
End
End Sub

Ghi lại thành file mnuTextR16.dvb trong thư mục C:\Program Files\AutoCAD 2006\Support. Nếu ghi ở thư mục khác thì trong ACad đánh lệnh options, chọn tab Files, sau đó Add đường dẫn tới file mnuTextR16.dvb.Chạy Macro AddMenuItemTextNếu muốn các lần sau menu trên tự chạy thì chỉnh sửa file acad2006.lsp trong thư mục C:\Program Files\AutoCAD 2006\Support:Thêm đoạn code sau vào cuối file:
Code:
(defun S::STARTUP()
(command "_VBALOAD" "mnuTextR16.dvb")
(command "_-vbarun" "AddMenuItemText")
)

Long me

Lòng ta sao quên bóng người mẹ thân yêu, tình thương sáng ngời
Từng bao năm mẹ thao thức
Nhưng mong con chóng nên người

Mẹ hay dắt con đi qua làng và âu yếm
Choàng cho chiếc khăn màu nắng vàng
Màu khăn ấy làm con nhớ những năm xưa còn niên thiếu

Mẹ đưa dắt con vào cuộc đời,
Mẹ bên con từ khi sớm mai trong tiếng cười
Mẹ đưa con về nơi thắm tươi muôn hoa đường đi tới chân trời

Lòng Mẹ lyrics on
http://music.yeucahat.com/song/Vietnamese/23933-Long-Me~Trong-Tan.html
Người mà tôi yêu suốt đời, mẹ của tôi giờ xa mãi rồi
Từ bao đêm tôi mong nhớ,
Nhớ thương hình bóng của người

Mẹ đứng khuất xa sau chân đồi
Và đôi mắt nhìn theo bóng con tận cuối trời
Đôi mắt ấy là khúc hát ru tôi qua ngày bão tố

Mẹ đứng khuất xa trong sương mờ, bàn tay vẫy
Thật êm ái như lời nhắc nhủ
Mẹ của tôi vầng trang sáng soi trong đêm trười đi tới chân trời