ctListBar控件制作菜单（仿天正屏幕菜单）

linshucai

用这个控件可以制作出色的仿天正的菜单，我想这个也是非常好的办法，一直都没有想到好的方法来实现，而ACCONT及OCX有下载，但没有介绍相关的方法来调用。用这个控件网上有现成的VB参考程序，方便宜行，而其中有不少问题存在：如何把图标放在左边？如何自动加载？如何与程序调用快捷？如何文本方式存储菜单信息？这都有待解决？这个程序基本解决，当然要感谢各位明经高手。本菜单程序可以免费共享哟，感谢郑立凯，张帆等出的VBA本书。本人常用LISP，而VBA则作为软件的补充。让界面更友好。

tnt1095

图片呢，看不见的呀

linshucai

创建一个窗体，在上面布置CommandButton1及ctListBar1，ImageList1控件

Dim strListName, strItemName As String
Dim intListNum, intItemNum As Integer

Sub userForm1_Load()
Call CommandButton1_Click
End Sub

Private Sub CommandButton1_Click()
ctListBar1.IconSize = 1
ctListBar1.AddList "翻译接线"
ctListBar1.AddList "标识"
ctListBar1.AddListItem 1, "导线", ImageList1.ListImages(1).Picture
ctListBar1.AddListItem 1, "常闭", ImageList1.ListImages(59).Picture
ctListBar1.AddListItem 1, "小林", ImageList1.ListImages(3).Picture
ctListBar1.AddListItem 1, "小B", ImageList1.ListImages(4).Picture
ctListBar1.AddListItem 1, "张三", ImageList1.ListImages(5).Picture
ctListBar1.AddListItem 1, "李四", ImageList1.ListImages(6).Picture
ctListBar1.AddListItem 2, "李四", ImageList1.ListImages(7).Picture
End Sub

Sub ctListBar1_ItemClick1(ByVal nList As Integer, ByVal nItem As Integer)

Select Case nList And nItem
    Case 1 And 1
    MsgBox "A_1"
    ThisDrawing.SendCommand ("line" & vbCr)
   
    Case 1 And 2
    MsgBox "A_2"
    ThisDrawing.SendCommand ("(JXYJ1" & """CB_2""" & ")" & vbCr)
   
    Case 1 And 3
    MsgBox "A_3"
    ThisDrawing.SendCommand ("(JXYJ1" & """CB_1""" & ")" & vbCr)

    Case 2 And 1
    ThisDrawing.SendCommand ("(JXYJ1" & """CB_5""" & ")" & vbCr)
   
    Case 2 And 2
    MsgBox "B_2"


    Case 3 And 1
    MsgBox "C_1"
   
    Case 3 And 2
    MsgBox "C_2"



    Case 4 And 1
    MsgBox "D_1"


    Case 5 And 1
    MsgBox "E_1"
'以上为第五级目录的连接

End Select

End Sub

Private Sub ctListBar1_ItemClick(ByVal nList As Integer, ByVal nItem As Integer)

  MsgBox "你点击的项目名称是：" & ctListBar1.ItemText(nList, nItem), vbInformation, nList & "-" & nItem

End Sub

将下面这个过程放在thisdrawing里
Sub AcadDocument_Activate()
UserForm1.Show vbModeless
End Sub

接下来就是如何文本文件方式进行存储，在菜单加载是加载。

linshucai

那么就看大家努力把它改得合理一些，让大家都来共享这样的成果哟

linshucai

现将ctlistbar使用说明及控件发上来，那么就只有从文本文件读取一行，并将每行分成四个部分

**××　××　

组代号　组名

ID××　××　××　××

序号　　名称　图标　命令

希望高手来化解这样的程序，让更多的朋友有一个免费的屏幕菜单来使用哟。

文本文件格式如下：

&&&BARNAME&&&小林电气

**lin     导线
id00     原理线     JXHLH     LINE
**ck     常开
id20     普通     JXHLH      (JXYJ1 "CK_1")
id21     刀开关     JXHLH     (JXYJ1 "CK_18")
id22     负荷开关     JXHLH     (JXYJ1 "CK_20")
id23     断路器     JXHLH     (JXYJ1 "CK_19")
id24     接触器     JXHLH     (JXYJ1 "CK_17")
id25     按钮     JXHLH     (JXYJ1 "CK_3")
id26     热继电器     JXHLH     (JXYJ1 "CK_14")
**cb     常闭
id27     普通     JXHLH     (JXYJ1 "CB_1")
id28     按钮     JXHLH     (JXYJ1 "CB_2")
id29     热继电器     JXHLH     (JXYJ1 "CB_5")
**xq     线圈
id30     普通     JXHLH     (JXYJ1 "XQ_1")
id31     时间继电器     JXHLH     (JXYJ1 "XQ_2")
id32     过流继电器     JXHLH     (JXYJ1 "XQ_3")
id33     欠流继电器     JXHLH     (JXYJ1 "XQ_4")
id34     过压继电器     JXHLH     (JXYJ1 "XQ_5")
id35     欠压继电器     JXHLH     (JXYJ1 "XQ_6")
**fuse     其他元件
id36     熔断器     JXFUS     (JXYJ1 "FU_1")
id37     信号灯     JXHLH     (JXYJ1 "XH_1")
id38     交叉点     JXHLH     lindonut
**INIT     标号线号
id2     标出线号     JXHLH     xhbz

azjmjsj

压缩包密码？？？？？

muzi2005888

密码.....

linshucai

Public ptcen As Variant
Public bpick As Boolean
Public strpath As String

Private Sub Form_Load()
Dim strtemp As String
Dim nfile, listnum, m As Integer
On Error GoTo errhandler
nfile = FreeFile
bpick = False
Open App.Path & "\xiaolin.INI" For Input As #nfile
listnum = 1
ctListBar1.IconSize = IconSmall
While Not EOF(nfile)

 Line Input #nfile, strtemp
 If Left$(strtemp, 1) = "*" Then
 strtemp = Right$(strtemp, (Len(strtemp) - 2))
 'MsgBox InStr(strtemp, ",")
 ctListBar1.AddList strtemp
 listnum = listnum + 1
 Else
  m = InStr(strtemp, ",") - 1
 
 strtemp = Left$(strtemp, m)
 intListNum = listnum
  'If intListNum <> 0 Then strItemName = strtemp
  If strtemp <> "" Then ctListBar1.AddListItem listnum, strtemp, ctListBar1.Image1
 End If
 
 Wend
 Close #nfile
 Exit Sub
errhandler:
 MsgBox "error no."
 Err.Clear
 
End Sub

Private Sub ctListBar1_ItemClick(ByVal nList As Integer, ByVal nItem As Integer)
 Dim strtemp As String
Dim nfile, listnum As Integer
nfile = FreeFile
  MsgBox "你点击的项目名称是：" & ctListBar1.ItemText(nList, nItem), vbInformation, nList & "-" & nItem
  Open App.Path & "\xiaolin.INI" For Input As #nfile
  While Not EOF(nfile)

 Line Input #nfile, strtemp
 If Left$(strtemp, InStr(strtemp, ",")) = ctListBar1.ItemText(nList, nItem) & "," Then
 strtemp = Right$(strtemp, (Len(strtemp) - InStr(strtemp, ",")))
 'MsgBox ctListBar1.ItemText(nList, nItem)
 MsgBox "ThisDrawing.SendCommand" & " (""" & strtemp & """ & vbCr)"
 End If
 Wend
 Close #nfile
End Sub

xiaolin.ini文件内容

原理线,LINE
**常开
普通常开,(JXYJ1 "CK_1")
刀开关常开,(JXYJ1 "CK_18")
负荷开关,(JXYJ1 "CK_20")
断路器常开,(JXYJ1 "CK_19")
接触器常开,(JXYJ1 "CK_17")
按钮常开,(JXYJ1 "CK_3")
热继电器常开,(JXYJ1 "CK_14")
**常闭
普通常闭,(JXYJ1 "CB_1")
按钮常闭,(JXYJ1 "CB_2")
热继电器常闭,(JXYJ1 "CB_5")
**线圈
普通线圈,(JXYJ1 "XQ_1")
时间继电器,(JXYJ1 "XQ_2")
过流继电器,(JXYJ1 "XQ_3")
欠流继电器,(JXYJ1 "XQ_4")
过压继电器,(JXYJ1 "XQ_5")
欠压继电器,(JXYJ1 "XQ_6")
**其他元件

这是我春节期间做的

1.新建一个窗体 名为Form

2.在上面放置CTLISTBAR控件名为ctListBar1

3.xiaolin.ini文件与工程文件放在同一目录下

而今问题如下：

1.如何将相应的命令发送到CAD里执行？

2.如何实现VB直接操作CAD运行相应命令？

3.生成EXE文件时为什么会没有调试时的界面？

gdzhou

先查找CAD，找到后调用API做为CAD的子窗体，再显示自制的菜单窗体

程序中设一全局变量存储CAD的连接，这样就可以用Sendcommand调用

相应命令了，

linshucai

而今却又发现编译存在问题，在VBA状态下则没有问题，借用明经里的高手

Function GetSupportPath() As String
Dim strFileName
strFileName = VBE.ActiveVBProject.FileName 'VBE.ActiveVBProject.FileName获取.dvb文件的文件名
GetSupportPath = Left$(strFileName, InStrRev(strFileName, "\"))
End Function

用GetSupportPath替换掉app.path

ThisDrawing.SendCommand strtemp + Chr(13)替换掉MsgBox "ThisDrawing.SendCommand" & " (""" & strtemp & """ & vbCr)"

窗体名及添加一个初始命令，在thisdrawing里加入

Private Sub AcadDocument_Activate()
UserForm1.Show vbModeless
End Sub

效果非常不错，呵呵