生成的菜单如下下图所示
menu.txt 的内容格式如下
8
田草工具箱,
田草标注,
田草文字,
田草修改,
田草显示,
田草建筑,
田草结构,
田草实体,
100,,
绘图工具面,绘图工具面,-vbarun ShowDrawFrm,,Draw,0
统计工具面板,统计工具面板,-vbarun ShowTotalFrm,,total,0
系统设置面板,系统设置面板,-vbarun ShowSetFrm,,set,0
关于...,关于...,-vbarun ShowAboutFrm,,about,0
标注,标注,open,true,0
文字,文字,open,true,0
修改,修改,open,true,0
显示,显示,open,true,0
建筑,建筑,open,true,0
结构,结构,open,true,0
实体,实体,open,true,0
弧长标注,弧长标注,-vbarun DimArcLen,,ARC,1
极坐标,极坐标,-vbarun DimJZB,,极坐标,1
田草工具箱,
田草标注,
田草文字,
田草修改,
田草显示,
田草建筑,
田草结构,
田草实体,
100,,
绘图工具面,绘图工具面,-vbarun ShowDrawFrm,,Draw,0
统计工具面板,统计工具面板,-vbarun ShowTotalFrm,,total,0
系统设置面板,系统设置面板,-vbarun ShowSetFrm,,set,0
关于...,关于...,-vbarun ShowAboutFrm,,about,0
标注,标注,open,true,0
文字,文字,open,true,0
修改,修改,open,true,0
显示,显示,open,true,0
建筑,建筑,open,true,0
结构,结构,open,true,0
实体,实体,open,true,0
弧长标注,弧长标注,-vbarun DimArcLen,,ARC,1
极坐标,极坐标,-vbarun DimJZB,,极坐标,1
第一行为生成的工具条个数(没有逗号)
后面跟的就是工具条名称(一个逗号)
100,, 是后面100个命令(二个逗号)(后面的命令可以比这个数值小但不能超过这个数值)
命令的名称,命令的提示,命令,,图标文件名,0 (五个逗号)(0为附着的工具条序号,0即为附着在第一个工具条上)。
命令的名称,命令的提示,open,true,0 (四个逗号)(这个是还有子菜单)
100,,前面的几行顺序不能颠倒,因为程序是安装顺序读取的,后面的到没有关系,因为已经指定了她附着的工具条序号。
后面跟的就是工具条名称(一个逗号)
100,, 是后面100个命令(二个逗号)(后面的命令可以比这个数值小但不能超过这个数值)
命令的名称,命令的提示,命令,,图标文件名,0 (五个逗号)(0为附着的工具条序号,0即为附着在第一个工具条上)。
命令的名称,命令的提示,open,true,0 (四个逗号)(这个是还有子菜单)
100,,前面的几行顺序不能颠倒,因为程序是安装顺序读取的,后面的到没有关系,因为已经指定了她附着的工具条序号。
Sub CreateMenu()
Dim i As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim j As Integer
Dim index() As Long
Dim temp As Integer
Dim TG As AcadMenuGroup
Dim T As AcadToolbar
Dim strPath As String
strPath = GetPath
Dim pathL As String, pathS As String
pathL = strPath & "Icons\Large\"
pathS = strPath & "Icons\Small\"
Dim FSO As Object
Dim FSO_File As Object
For Each TG In ThisDrawing.Application.MenuGroups
If TG.Name = "ACAD" Then
If TG.Toolbars.item("绘图").DockStatus <> acToolbarDockRight Then TG.Toolbars.item("绘图").Dock acToolbarDockRight
If TG.Toolbars.item("修改").DockStatus <> acToolbarDockRight Then TG.Toolbars.item("修改").Dock acToolbarDockRight
End If
Next
Dim ToolBar() As AcadToolbar
Dim MenuGroupObject As AcadMenuGroup
Dim SmallBitmapName() As String
Dim LargeBitmapName() As String
Dim ButtonObject() As AcadToolbarItem
Set MenuGroupObject = ThisDrawing.Application.MenuGroups.item(0)
Dim DataString As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True)
Do While Not FSO_File.AtEndOfStream
DataString = FSO_File.ReadLine
i = inStr_n(DataString, ",", index)
If i = 0 Then
ReDim ToolBar(Val(DataString) - 1)
ElseIf i = 1 Then
DataString = Left(DataString, Len(DataString) - 1)
For Each TG In ThisDrawing.Application.MenuGroups
For Each T In TG.Toolbars
If T.Name = DataString Then
T.Delete
End If
Next
Next
Set ToolBar(i1) = MenuGroupObject.Toolbars.Add(DataString)
i1 = i1 + 1
ElseIf i = 2 Then
ReDim SmallBitmapName(Val(DataString) - 1)
ReDim LargeBitmapName(Val(DataString) - 1)
ReDim ButtonObject(Val(DataString) - 1)
ElseIf i = 5 Then
temp = Val(Mid(DataString, index(4) + 1))
Set ButtonObject(i2) = ToolBar(temp).AddToolbarButton(ToolBar(temp).Count + 1, Left(DataString, index(0) - 1), Mid(DataString, index(0) + 1, index(1) - index(0) - 1), Mid(DataString, index(1) + 1, index(2) - index(1) - 1) + Chr(13))
SmallBitmapName(i2) = pathS & Mid(DataString, index(3) + 1, index(4) - index(3) - 1) & ".bmp"
LargeBitmapName(i2) = pathL & Mid(DataString, index(3) + 1, index(4) - index(3) - 1) & ".bmp"
ButtonObject(i2).SetBitmaps SmallBitmapName(i2), LargeBitmapName(i2)
i2 = i2 + 1
i3 = i3 + 1
ElseIf i = 4 Then
temp = Val(Mid(DataString, index(3) + 1))
Set ButtonObject(i2) = ToolBar(temp).AddToolbarButton(ToolBar(temp).Count + 1, Left(DataString, index(0) - 1), Mid(DataString, index(0) + 1, index(1) - index(0) - 1), "OPEN", True)
ButtonObject(i2).AttachToolbarToFlyout MenuGroupObject.Name, ToolBar(i3 + i4 - 3).Name
i2 = i2 + 1
i4 = i4 + 1
End If
Loop
FSO_File.Close
ToolBar(0).Dock acToolbarDockLeft
For i = 1 To i1 - 1
ToolBar(i).Visible = False
Next
End Sub
Dim i As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim j As Integer
Dim index() As Long
Dim temp As Integer
Dim TG As AcadMenuGroup
Dim T As AcadToolbar
Dim strPath As String
strPath = GetPath
Dim pathL As String, pathS As String
pathL = strPath & "Icons\Large\"
pathS = strPath & "Icons\Small\"
Dim FSO As Object
Dim FSO_File As Object
For Each TG In ThisDrawing.Application.MenuGroups
If TG.Name = "ACAD" Then
If TG.Toolbars.item("绘图").DockStatus <> acToolbarDockRight Then TG.Toolbars.item("绘图").Dock acToolbarDockRight
If TG.Toolbars.item("修改").DockStatus <> acToolbarDockRight Then TG.Toolbars.item("修改").Dock acToolbarDockRight
End If
Next
Dim ToolBar() As AcadToolbar
Dim MenuGroupObject As AcadMenuGroup
Dim SmallBitmapName() As String
Dim LargeBitmapName() As String
Dim ButtonObject() As AcadToolbarItem
Set MenuGroupObject = ThisDrawing.Application.MenuGroups.item(0)
Dim DataString As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True)
Do While Not FSO_File.AtEndOfStream
DataString = FSO_File.ReadLine
i = inStr_n(DataString, ",", index)
If i = 0 Then
ReDim ToolBar(Val(DataString) - 1)
ElseIf i = 1 Then
DataString = Left(DataString, Len(DataString) - 1)
For Each TG In ThisDrawing.Application.MenuGroups
For Each T In TG.Toolbars
If T.Name = DataString Then
T.Delete
End If
Next
Next
Set ToolBar(i1) = MenuGroupObject.Toolbars.Add(DataString)
i1 = i1 + 1
ElseIf i = 2 Then
ReDim SmallBitmapName(Val(DataString) - 1)
ReDim LargeBitmapName(Val(DataString) - 1)
ReDim ButtonObject(Val(DataString) - 1)
ElseIf i = 5 Then
temp = Val(Mid(DataString, index(4) + 1))
Set ButtonObject(i2) = ToolBar(temp).AddToolbarButton(ToolBar(temp).Count + 1, Left(DataString, index(0) - 1), Mid(DataString, index(0) + 1, index(1) - index(0) - 1), Mid(DataString, index(1) + 1, index(2) - index(1) - 1) + Chr(13))
SmallBitmapName(i2) = pathS & Mid(DataString, index(3) + 1, index(4) - index(3) - 1) & ".bmp"
LargeBitmapName(i2) = pathL & Mid(DataString, index(3) + 1, index(4) - index(3) - 1) & ".bmp"
ButtonObject(i2).SetBitmaps SmallBitmapName(i2), LargeBitmapName(i2)
i2 = i2 + 1
i3 = i3 + 1
ElseIf i = 4 Then
temp = Val(Mid(DataString, index(3) + 1))
Set ButtonObject(i2) = ToolBar(temp).AddToolbarButton(ToolBar(temp).Count + 1, Left(DataString, index(0) - 1), Mid(DataString, index(0) + 1, index(1) - index(0) - 1), "OPEN", True)
ButtonObject(i2).AttachToolbarToFlyout MenuGroupObject.Name, ToolBar(i3 + i4 - 3).Name
i2 = i2 + 1
i4 = i4 + 1
End If
Loop
FSO_File.Close
ToolBar(0).Dock acToolbarDockLeft
For i = 1 To i1 - 1
ToolBar(i).Visible = False
Next
End Sub
[本日志由 tiancao1001 于 2009-03-06 11:30 AM 编辑]
|
sujianyong 于 2009-03-05 11:22 PM 发表评论:
佩服
tiancao1001 于 2008-07-16 02:58 PM 发表评论:
Sub DeleteMenu()
'读取有那些菜单
Dim i As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim index() As Long
Dim DataString As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True)
Do While Not FSO_File.AtEndOfStream
DataString = FSO_File.ReadLine
i = inStr_n(DataString, ",", index)
If i = 0 Then
i1 = Val(DataString)
ElseIf i = 1 Then
DataString = Left(DataString, Len(DataString) - 1)
For Each TG In ThisDrawing.Application.MenuGroups
For Each T In TG.Toolbars
If T.Name = DataString Then
T.Delete
i2 = i2 + 1
If i2 = i1 Then Exit Do
End If
Next
Next
End If
Loop
FSO_File.Close
End Sub
'读取有那些菜单
Dim i As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim index() As Long
Dim DataString As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True)
Do While Not FSO_File.AtEndOfStream
DataString = FSO_File.ReadLine
i = inStr_n(DataString, ",", index)
If i = 0 Then
i1 = Val(DataString)
ElseIf i = 1 Then
DataString = Left(DataString, Len(DataString) - 1)
For Each TG In ThisDrawing.Application.MenuGroups
For Each T In TG.Toolbars
If T.Name = DataString Then
T.Delete
i2 = i2 + 1
If i2 = i1 Then Exit Do
End If
Next
Next
End If
Loop
FSO_File.Close
End Sub
发表评论 - 不要忘了输入验证码哦! |