|
|
Sub CreateZaBar()
'创建合路器栏,衰减器及负载按钮
'连接当前活动文档
'Set ThisDrawing = acadApp.ActiveDocument
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
'创建工具栏
Dim newToolBar As AcadToolbar
'检查工具栏是否已经存在
For Each newToolBar In currMenuGroup.Toolbars
If newToolBar.Name = "ZaBar" Then
newToolBar.Delete
End If
Next newToolBar
Set newToolBar = currMenuGroup.Toolbars.Add("ZaBar")
'获取安装目录路径
Dim path1 As String
Dim m As New ClsAccess
path1 = m.GetAccessPath
path1 = m.GetPath(path1)
'添加工具栏
Dim CoupleButton1 As AcadToolbarItem
Dim SmallBitmapName As String, LargeBitmapName As String
Dim Macro1 As String
Dim CoupleButton2 As Object
'插入二网合路器按钮
Macro1 = Chr(3) & Chr(3) & "InserCombiner2" & vbCr
'Macro1 = " "
Set CoupleButton1 = newToolBar.AddToolbarButton(newToolBar.Count + 1, "插入二网合路器", "插入二网合路器", Macro1, True)
Dim ComBar As AcadToolbar
Set ComBar = currMenuGroup.Toolbars.Add("Com2Bar111111211")
'添加按钮
Macro1 = Chr(3) & Chr(3) & "InserCom21" & vbCr
Set CoupleButton2 = ComBar.AddToolbarButton(newToolBar.Count + 1, "插入二网合路器形态1", "插入二网合路器形态1", Macro1)
'添加显示图片
SmallBitmapName = path1 & "图片\Combiner\Combiner21.bmp" ' Use a 16x16 pixel .BMP image
LargeBitmapName = path1 & "图片\Combiner\Combiner21.bmp" ' Use a 32x32 pixel .BMP image
CoupleButton2.SetBitmaps SmallBitmapName, LargeBitmapName
'添加按钮
Macro1 = Chr(3) & Chr(3) & "InserCom23" & vbCr
Set CoupleButton2 = ComBar.AddToolbarButton(newToolBar.Count + 1, "插入二网合路器形态3", "插入二网合路器形态3", Macro1)
'添加显示图片
SmallBitmapName = path1 & "图片\Combiner\Combiner23.bmp" ' Use a 16x16 pixel .BMP image
LargeBitmapName = path1 & "图片\Combiner\Combiner23.bmp" ' Use a 32x32 pixel .BMP image
CoupleButton2.SetBitmaps SmallBitmapName, LargeBitmapName
'添加按钮
Macro1 = Chr(3) & Chr(3) & "InserCom22" & vbCr
Set CoupleButton2 = ComBar.AddToolbarButton(newToolBar.Count + 1, "插入二网合路器形态2", "插入二网合路器形态2", Macro1)
'添加显示图片
SmallBitmapName = path1 & "图片\Combiner\Combiner22.bmp" ' Use a 16x16 pixel .BMP image
LargeBitmapName = path1 & "图片\Combiner\Combiner22.bmp" ' Use a 32x32 pixel .BMP image
CoupleButton2.SetBitmaps SmallBitmapName, LargeBitmapName
'添加按钮
Macro1 = Chr(3) & Chr(3) & "InserCom24" & vbCr
Set CoupleButton2 = ComBar.AddToolbarButton(newToolBar.Count + 1, "插入二网合路器形态4", "插入二网合路器形态4", Macro1)
'添加显示图片
SmallBitmapName = path1 & "图片\Combiner\Combiner24.bmp" ' Use a 16x16 pixel .BMP image
LargeBitmapName = path1 & "图片\Combiner\Combiner24.bmp" ' Use a 32x32 pixel .BMP image
CoupleButton2.SetBitmaps SmallBitmapName, LargeBitmapName
'将LoadBar与CoupleButton1相连
CoupleButton1.AttachToolbarToFlyout currMenuGroup.Name, ComBar.Name
’ComBar.Visible = False
end sub
但运行完，在弹出式工具栏中却显示不出图例，只是白板！在04,05下有这个问题，请高手解答 |
|
置顶卡
