码迷,mamicode.com
首页 > 编程语言 > 详细

AutoCAD VBA添加菜单

时间:2019-05-31 23:54:34      阅读:928      评论:0      收藏:0      [点我收藏+]

标签:this   mamicode   sig   image   load   app   private   dba   win   

# 给cad添加自定义菜单

技术图片

 

技术图片
 1 Private Sub AddBar()
 2     Dim NewMenuItem As AcadPopupMenuItem
 3     Dim TheMacro As String
 4     Dim MI As Integer
 5     
 6     On Error Resume Next
 7     Dim currMenuGroup As AcadMenuGroup
 8     Set currMenuGroup = Application.MenuGroups.Item(0)
 9     Create the new menu
10     Set NewMenu = currMenuGroup.Menus.Add("批量绘图")
11     If Err.Number Then
12         Err.Clear
13         For Each NewMenu In currMenuGroup.Menus
14             If NewMenu.Name = "批量绘图" Then Exit For
15         Next
16     End If
17     
18     Add a menu item to the new menu
19     Assign the macro string the VB equivalent of "ESC ESC _open "
20     TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""GeoSection.dvb!DZPM.GeoSection""" & Chr(32)
21     TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""MainSub""" & Chr(32)
22     Set NewMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, "批量绘图", TheMacro)
23     If Err.Number Then Err.Clear
24     Display the menu on the menu bar
25     NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
26     If Err.Number Then Err.Clear
27 End Sub
View Code

写几个事件驱动菜单显示

技术图片

 

技术图片
 1 Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
 2     If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
 3     If NewMenu Is Nothing Then AddBar
 4 End Sub
 5 
 6 Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
 7     If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub
 8     If NewMenu Is Nothing Then AddBar
 9 End Sub
10 
11 Public Sub MainSub()
12     Dim frm As New UserForm1
13     Call UserForm1.Show
14 End Sub
View Code

 最终效果

技术图片

 

AutoCAD VBA添加菜单

标签:this   mamicode   sig   image   load   app   private   dba   win   

原文地址:https://www.cnblogs.com/NanShengBlogs/p/10957730.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!