VBA for AutoCAD

Liên hệ QC
nvson

nvson

Geotechnics
Thành viên danh dự
Tham gia
20/9/06
Bài viết
793
Được thích
1,285
Nghề nghiệp
ĐCTV - ĐCCT
Nguyên văn từ anh Hướng:
Mình nghĩ không nhất thiết Sơn phải gửi lên diễn đàn, nhưng nếu có thể, em post từng mục một. Ví dụ như cách tạo menu, chọn và tô mặt cắt, hoặc giao diện của hình trụ hay mặt cắt ĐCCT,...
Có rất nhiều người cám ơn những kiến thức của em đã và sẽ chia sẻ.
Nhấp chuột vào đây để mở rộng...

Nguyên văn từ skyonline:
Đúng như lời anh Huớng nói thì anh không nên post cả cái file đó mà chỉ cần post hướng dẫn từng phần như thế mọi người muốn có file ứng dụng đó thì phải tự mình hoàn thành các bước như thế trình độ nó mới nâng cao được
Nhấp chuột vào đây để mở rộng...
.....................................................
 
Cách tạo và xoá menu:
(Vì tôi sử dụng AutoCAD 2006 nên tất cả các bài viết đều thực hiện trên phiên bản này).
Trong AutoCAD nhấn Alt+F11 để mở Microsoft Visual Basic.
Nháy đúp chuột vào This Drawing, rồi thêm đoạn mã sau:
Mã: 
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

Mã: 
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):
Mã: 
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 AddMenuItemText

Nế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:
Mã: 
(defun S::STARTUP() 
    (command "_VBALOAD" "mnuTextR16.dvb") 
    (command "_-vbarun" "AddMenuItemText")
)
 

File đính kèm

  • r16.rar
    8 KB · Đọc: 450
Dear nvson,
------------
Bạn có thể giải thích kỹ hơn về "VBA for AutoCAD được không?
Cám ơn bạn!
 
Mình nghĩ VBA for AutoCAD cũng tương tự như VBA for Excel, nhưng VBA for AutoCAD có những đối tượng riêng của nó và nó cũng bao gồm các hàm giống như AutoLISP. Những ai đã biết VB, VBA for Excel và AutoLISP chắc không gặp khó khăn khi chuyển sang VBA for AutoCAD.

Ghi chú: Mặc dù trong AutoCAD 2006 đã có những lệnh về Text rồi nhưng chúng lại xử lý tiếng Việt rất kém (chỉ làm việc tốt với font Unicode). Mấy lệnh trên sẽ khắc phục được lỗi đó.
 
Cám ơn ngvson, em có so sánh gì về VBA và Autolips không. Anh thấy lệnh trong autolisp ngắn gọn, dễ hiểu, thực hiện nhanh. Còn VBA thì hơi cồng kềnh nhưng linh hoạt,....
 
Anh thấy lệnh trong autolisp ngắn gọn, dễ hiểu, thực hiện nhanh. Còn VBA thì hơi cồng kềnh nhưng linh hoạt,....
Nhấp chuột vào đây để mở rộng...

Đúng như anh nói AutoLISP thực hiện nhanh nhưng ngắn gọn và dễ hiểu thì chắc chắn là không thể bằng VBA for AutoCAD được vì:
VBA lập trình trực quan, giao diện nhìn thấy ngay. Với AutoLISP mà lập được một hộp thoại (Dialog) thì sẽ mất rất nhiều công sức, còn VBA for AutoCAD thì đơn giản hơn rất nhiều.
Cú pháp của AutoLISP cũng khó cho người mới bắt đầu làm quen (có quá nhiều dấu ngoặc...), không có trình biên dịch, khó phát hiện lỗi... còn VBA for AutoCAD thì khắc phục được những nhược điểm của AutoLISP....
Đó là những ý kiến của riêng em, tuy nhiên nó cũng còn tuỳ vào người lập trình đã quen với ngôn ngữ nào...
 
Tạo mẫu tô mới trong AutoCAD

Trong AutoCAD có rất nhiều mẫu tô nhưng chắc chắn không thể có những mẫu tô phục vụ cho một chuyên ngành nào đó. Để linh hoạt AutoCAD cho phép người dùng tự tạo ra các mẫu tô riêng, cú pháp như sau:

Mã: 
*Name [, Description]
Angle, Origin-x, Origin-y, delta-x, delta-y [, dash1, dash2...]
trong đó:
*: là dấu bắt buộc
Name: Tên mẫu tô
Description: Mô tả mẫu tô (cái này có thể có hoặc không, nhưng nếu có thì được ngăn cách với Name bằng dấu phẩy (,)
Angle: góc nghiêng của nét
Origin-x, Origin-y: Toạ độ điểm đầu
delta-x, delta-y: Độ xe dịch theo phương x, y
dash1, dash2...: kiểu nét
dash = 0 --> thể hiện một dấu chấm (.)
dash > 0 --> độ dài nét vẽ
dash < 0--> độ dài một khoảng trống

Xét ví dụ đơn giản sau:
*Dash45, cau truc mau to
45, 0, 0, 0, 0.375, 0.5, -0.5

Có nghĩa là: Acad dùng đường nét đứt nghiêng 45 độ gồm các vạch dài 0.5 đơn vị xen kẽ với các khoảng trống rộng 0.5 đơn vị.

Để tô được trong AutoCAD, bạn hãy thêm 2 dòng trên vào cuối file acad.pat trong thư mục C:\Program Files\AutoCAD R14\SUPPORT (với R14) hoặc C:\Documents and Settings\(Your UserName)\Application Data\Autodesk\AutoCAD 2006\R16.2\enu\Support (với R16)
Chạy AutoCAD và thử tô với mẫu Dash45.

Và đây là một mẫu tô khác:
Mã: 
*SON, Mau to chu
0,0,0,5,4,1,-1,1,-7
90,1,0,4,5,1,-7
0,0,1,5,4,1,-9
90,0,1,4,5,1,-7
0,0,2,5,4,1,-1,1,-1,1,-5
90,2,0,4,5,2,-6
90,3,0,4,5,2,-6
90,4,0,4,5,2,-6
90,5,0,4,5,2,-6
90,3,2,4,5,0.5,-7.5
0,2.5,2.5,5,4,0.5,-9.5
 
nvson đã viết:
Mình nghĩ VBA for AutoCAD cũng tương tự như VBA for Excel, nhưng VBA for AutoCAD có những đối tượng riêng của nó và nó cũng bao gồm các hàm giống như AutoLISP. Những ai đã biết VB, VBA for Excel và AutoLISP chắc không gặp khó khăn khi chuyển sang VBA for AutoCAD.

Ghi chú: Mặc dù trong AutoCAD 2006 đã có những lệnh về Text rồi nhưng chúng lại xử lý tiếng Việt rất kém (chỉ làm việc tốt với font Unicode). Mấy lệnh trên sẽ khắc phục được lỗi đó.
Nhấp chuột vào đây để mở rộng...
Dear nvson
Thật ra trong AutoCAD 2006 vẫn xử lý tốt tiếng Việt cho các loại font VNI, ABC,... bạn có thể tham khảo ở đây http://www.ketcau.com/forum/showthread.php?t=2213
 
Tôi nghĩ không cần thiết chạy đua các theo phiên bản phần mềm mới. Vì công việc của chúng ta hầu hết không quá cần đến mức độ khai thác quá sâu.
Tôi vẫn dùng AutoCad14 và 2004 thôi, ổn lắm, chưa tìm hiểu về 2006.
 
PhanTuHuong đã viết:
Tôi nghĩ không cần thiết chạy đua các theo phiên bản phần mềm mới. Vì công việc của chúng ta hầu hết không quá cần đến mức độ khai thác quá sâu
Nhấp chuột vào đây để mở rộng...
Em thấy chạy AutoCAD R14 là nhanh nhất, nhưng có những lúc mình phải lấy file ở một phòng ban, công ty... khác, nếu họ sử dụng phiên bản cao hơn thì cũng mất công Convert về 2004 hoặc R14 ---> vẫn phải sử dụng phiên bản cao...
(Đó cũng chỉ là một lý do trong rất nhiều lý do để sử dụng phiên bản mới)
 
macro copy Cad_Excel khong chay duoc trong Cad2007

nvson đã viết:
.....................................................
Nhấp chuột vào đây để mở rộng...
bạn có thể chỉ cho tôi cách chạy 1 ứng dụng macro copy cad_excel trong cad2007 tôi đã chạy tốt trong 2004 nhưng 2007 thì không
thank you
 
Các bác chỉ giùm em cái!!!

Các bác cho em hỏi làm sao khai báo VBA for Cad để ta có thể:
+ đọc được dữ liệu trên 1 file Excel cho trước (ví dụ lấy giá trị ở cell(1,1) của file C:\Data1.xls gán vào acad.textstring)
+ mở và ghi tiếp (append) vào 1 file Excel cho trước (ví dụ lấy giá trị ở acad.textstring gán vào cell(2,1) của file C:\Data2.xls)
Em làm mãi mà không được, các anh hướng dẫn em
 
To vietha209:
vietha209 đã viết:
Các bác cho em hỏi làm sao khai báo VBA for Cad để ta có thể:
+ đọc được dữ liệu trên 1 file Excel cho trước (ví dụ lấy giá trị ở cell(1,1) của file C:\Data1.xls gán vào acad.textstring)
+ mở và ghi tiếp (append) vào 1 file Excel cho trước (ví dụ lấy giá trị ở acad.textstring gán vào cell(2,1) của file C:\Data2.xls)
Em làm mãi mà không được, các anh hướng dẫn em
Nhấp chuột vào đây để mở rộng...
Mình làm trên AutoCAD 2006, MS Excel 2003
Bạn thử làm theo các bước sau nhé:
Khởi động AutoCAD
Nhấn Alt+F11 để vào VBA
NHấn Insert/ Module
Nhấn tiếp Tools/ References, Chọn Microssoft Excel 11.0 Object Library
(Nếu bạn sử dụng Excel không phải phiên bản 2003 thì số trên sẽ khác)
Thêm đoạn code sau vào Module:
Mã: 
Option Explicit
Dim x1 As Object
Dim x2 As Object
Dim x3 As Object
Public Sub Doc_Ghi_Solieu()
On Error Resume Next
Set x1 = CreateObject("Excel.Application")
'
Set x2 = x1.Workbooks.Open(FileName:="D:\Data1.xls", UpdateLinks:=0)
ActiveWorkbook.RunAutoMacros Which:=xlAutoOpen
'
Set x3 = x1.Workbooks.Open(FileName:="D:\Data2.xls", UpdateLinks:=0)
ActiveWorkbook.RunAutoMacros Which:=xlAutoOpen
'
x1.Visible = False
'
Dim sht_Data1, sht_Data2
Dim Giatri
'
Set sht_Data1 = x2.Worksheets("Sheet1")
sht_Data1.Activate
'Doc so lieu tu file Data1.xls va luu vao bien Giatri
Giatri = sht_Data1.Cells(1, 1).text
MsgBox Giatri
'
'Ghi so lieu vao file D:\Data2.xls
Set sht_Data2 = x3.Worksheets("Sheet1")
sht_Data2.Cells(2, 1).Value = Giatri
x2.Close
x3.Close
End Sub
Chú ý ở ổ D của bạn bây giờ phải có 2 file Data1.xls (đã có số liệu) và file Data2.xls (có hoặc chưa có số liệu)
Chạy Macro trên.
Chúc bạn thành công!
 
Không biết phải cảm ơn anh như thế nào nữa, chỉ biết nhấn nút thanks mà thôi. Em đã test và OK. Một lần nữa cám ơn anh rất nhiều
 
tôi mới ra trường và cũng chỉ mơi bắt đầu làm quen với VBA thôi. Trong công việc hiện tại nếu biết đôi chút về VBA thì rút ngắn thời gian rất nhiều. Cám ơn mọi người đã tận tình trao đổi tren diễn đàn để anh em còn học hỏi. Không có gì lớn lao đóng góp cho diễn đàn tui có chút xíu về cài đặt autocad2006 gọi là cho vui : + Để xuất hiện menu express : gõ lệnh menuload; chon browse; chọn file AecArchXOE là được+ Để gõ được tiếng việt : - Gõ dtexted; chọn 1- Gõ Mtexted; gõ: oldeditorthế là xong
 
Cảm ơn các bài viết của các anh. Em đã học sơ qua VBA này, nhưng làm mãi mà vẫn không biết cách để chạy. Bây giờ thì mọi chuyện đã dễ dàng hơn một tý rồi.
Em mới viết lại cách tạo một menu tương tự như của anh Sơn nhưng có một số trở ngại sau:
1. Em muốn tạo gạch ngang một đường sau các NewMenuItem bằng AddSeparator, nhưng chỉ tạo được đường gạch kế cuối, chứ không như mong muốn. Em đã đọc help rồi nhưng vẫn chưa hiểu được.
2. Sau khi em chạy Macro này lên, khi Remove đi, rồi chạy lại thì nó lại báo như dưới. Chỉ có thoát CAD ra mới được.
Popup menu Thiet ke cau exists in the menu group.
3. Sau khi viết xong, em lưu dưới dạng đuôi *.dvb. Nhưng khi import thì không có đuôi dạng này. Vậy, em muốn lấy lại file vừa lưu như thế nào.
Em gửi các bác nhờ xem giúp em. Em xin cảm ơn nhiều!
Sub AddMenuItemTKC()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

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

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

' Add the submenu Cau ban
Dim FileSubMenu1 As AcadPopupMenu
Set FileSubMenu1 = newMenu.AddSubMenu("", "Cau ban")

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caubanmonhe" & Chr(32)
Set newMenuItem = FileSubMenu1.AddMenuItem(newMenu.Count + 1, "Cau ban mo nhe", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caubanmodeo" & Chr(32)
Set newMenuItem = FileSubMenu1.AddMenuItem(newMenu.Count + 1, "Cau ban mo deo", openMacro)
' Add the submenu Cau dam
Dim FileSubMenu2 As AcadPopupMenu
Set FileSubMenu2 = newMenu.AddSubMenu("", "Cau dam")

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caudamhop" & Chr(32)
Set newMenuItem = FileSubMenu2.AddMenuItem(newMenu.Count + 1, "Cau dam hop", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN CaudamchuT" & Chr(32)
Set newMenuItem = FileSubMenu2.AddMenuItem(newMenu.Count + 1, "Cau dam chu T", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN CaudamchuI" & Chr(32)
Set newMenuItem = FileSubMenu2.AddMenuItem(newMenu.Count + 1, "Cau dam chu I", openMacro)
' Add a separator to the end of the menu
Dim newMenuSeparator1 As AcadPopupMenuItem
Set newMenuSeparator1 = newMenu.AddSeparator(1)

' Add the submenu mo cau
Dim FileSubMenu3 As AcadPopupMenu
Set FileSubMenu3 = newMenu.AddSubMenu("", "Mo Cau")

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MochuU" & Chr(32)
Set newMenuItem = FileSubMenu3.AddMenuItem(newMenu.Count + 1, "Mo chu U", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Mochande" & Chr(32)
Set newMenuItem = FileSubMenu3.AddMenuItem(newMenu.Count + 1, "Mo chan de", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Movui" & Chr(32)
Set newMenuItem = FileSubMenu3.AddMenuItem(newMenu.Count + 1, "Mo vui", openMacro)

' Add a separator to the end of the menu
Dim newMenuSeparator2 As AcadPopupMenuItem
Set newMenuSeparator2 = newMenu.AddSeparator(2)

' Add the submenu tru cau
Dim FileSubMenu4 As AcadPopupMenu
Set FileSubMenu4 = newMenu.AddSubMenu("", "Tru Cau")

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trudac" & Chr(32)
Set newMenuItem = FileSubMenu4.AddMenuItem(newMenu.Count + 1, "Tru dac", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trucottron" & Chr(32)
Set newMenuItem = FileSubMenu4.AddMenuItem(newMenu.Count + 1, "Tru cot tron", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trucotvuong" & Chr(32)
Set newMenuItem = FileSubMenu4.AddMenuItem(newMenu.Count + 1, "Tru cot vuong", openMacro)
' Add a separator to the end of the menu
Dim newMenuSeparator3 As AcadPopupMenuItem
Set newMenuSeparator3 = newMenu.AddSeparator(3)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Tacgia" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Gioi thieu tac gia", openMacro)
' Display the menu on the menu bar
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub
Sub Tacgia()
TG.show
End Sub
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_mnuThiet ke cau" Then
oPopup.RemoveFromMenuBar
oPopup.Delete
End If
Next oPopup
End Sub
Nhấp chuột vào đây để mở rộng...
 
1. Em muốn tạo gạch ngang một đường sau các NewMenuItem bằng AddSeparator, nhưng chỉ tạo được đường gạch kế cuối, chứ không như mong muốn. Em đã đọc help rồi nhưng vẫn chưa hiểu được.
Nhấp chuột vào đây để mở rộng...
Bạn chạy đoạn Code sau:
Mã: 
Option Explicit
'http://www.giaiphapexcel.com/forum/showthread.php?p=39975
Sub AddMenuItemTKC()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
Dim FileSubMenu As AcadPopupMenu
Dim newMenuSeparator As AcadPopupMenuItem
' Create the new menu
Set newMenu = currMenuGroup.Menus.Add("Thiet ke cau")
'__________________________________
' Add the submenu Cau ban
Set FileSubMenu = newMenu.AddSubMenu("", "Cau ban")
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caubanmonhe" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Cau ban mo nhe", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caubanmodeo" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Cau ban mo deo", openMacro)
' Add a separator to the end of the menu
newMenu.AddSeparator (newMenu.Count + 1)
'__________________________________
' Add the submenu Cau dam
Set FileSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "Cau dam")
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Caudamhop" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Cau dam hop", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN CaudamchuT" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Cau dam chu T", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN CaudamchuI" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Cau dam chu I", openMacro)
' Add a separator to the end of the menu
newMenu.AddSeparator (newMenu.Count + 1)
'__________________________________
' Add the submenu mo cau
Set FileSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "Mo Cau")
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MochuU" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Mo chu U", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Mochande" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Mo chan de", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Movui" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Mo vui", openMacro)
' Add a separator to the end of the menu
newMenu.AddSeparator (newMenu.Count + 1)
'__________________________________
' Add the submenu tru cau
Set FileSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "Tru Cau")
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trudac" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Tru dac", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trucottron" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Tru cot tron", openMacro)
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Trucotvuong" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "Tru cot vuong", openMacro)
' Add a separator to the end of the menu
newMenu.AddSeparator (newMenu.Count + 1)
'__________________________________
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Tacgia" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Gioi thieu tac gia", openMacro)
' Display the menu on the menu bar
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

'______________________________
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.Name = "Thiet ke cau" Then
        oPopup.RemoveFromMenuBar
    End If
Next oPopup
End Sub
2. Sau khi em chạy Macro này lên, khi Remove đi, rồi chạy lại thì nó lại báo như dưới. Chỉ có thoát CAD ra mới được.
Popup menu Thiet ke cau exists in the menu group.
Nhấp chuột vào đây để mở rộng...
Đúng vậy, sau khi chạy macro AddMenuItemTKC, chạy tiếp macro removeMenu thì phải khởi động lại AutoCAD mới chạy lại được macro AddMenuItemTKC (mình cũng ko biết tại sao nữa !?).
3. Sau khi viết xong, em lưu dưới dạng đuôi *.dvb. Nhưng khi import thì không có đuôi dạng này. Vậy, em muốn lấy lại file vừa lưu như thế nào.
Nhấp chuột vào đây để mở rộng...
Bạn đánh lệnh AP (Tools/ Load Application) để load file *.dvb mà bạn vừa tạo.

P/s: Bạn đọc thêm bài "Cách tạo và xoá menu" ở trên nhé (đoạn cuối đấy để biết cách tự load).
 
Thật sự cảm ơn anh Sơn nhiều!
Tối qua, em đã thử lại với separator với NewmenuItem.Count +1 nhưng vẫn không được, chỉ riêng với ap cho *.dvb là được thôi. bây giờ, nhờ anh mà đã OK.
Riêng cái thứ hai vẫn phải nhờ các bác cao thủ khác giúp thêm.
vẫn phải nhờ anh Sơn và các bác nhiều, vì em chỉ mới bắt đầu.
Cảm ơn các bác nhiều!!
 
Em đang tìm cách tạo một ô lưới dạng như Excel để việc nhập dữ liệu đơn giản hơn dùng Excel để xuất qua. Em thấy chức năng Microsoft Flex Grid Control trong VB có thể dùng được, nên em qua CAD để thử. Tuy nhiên, khi em vào cả 2 mục:Tools/References, rồi Tools/Additional Controls, đánh vào các mục: Microsoft Flex Grid Control thì báo lỗi chưa đăng ký. Em down các file này trên thư viện Windows về và cài đặt thì khi kéo cái bảng này ra thì nó lại báo: Class not registered.
Rất mong các bác gỡ rối giúp em!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
15
Đọc
174
VetMini
V
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
17
Đọc
388
BuiQuangThuan
B
Q
trả lời google form bằng VBA excel
Trả lời
2
Đọc
78
quoc1995db
Q
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
8
Đọc
206
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
21
Đọc
388
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom