用VB 编写AUTOCAD 菜单 源代码
求用VB 编写AUTOCAD 菜单 源代码 这里找找Public Sub AddMenuItem(objCAD As Object)
' 该示例创建一个名为TestMenu 的新菜单，并在其中插入一个菜单项。
' 然后将菜单显示在菜单栏中。
' 在执行完该宏后如果需要将该菜单删除，可从【工具】菜单的【自定义菜单】项中删除。
Dim currMenuGroup As Object 'AcadMenuGroup
Set currMenuGroup = objCAD.menugroups.Item(0)
' 创建新菜单
Dim newMenu As Object ' AcadPopupMenu
Dim flag As Boolean
For Each newMenu In currMenuGroup.Menus
If newMenu.Name = "辅助工具(&B)" Then
flag = True
End If
Next
If flag Then
Set newMenu = currMenuGroup.Menus.Item("辅助工具(&B)")
If newMenu.OnMenuBar Then
Exit Sub
Else
newMenu.InsertInMenuBar (objCAD.MenuBar.Count + 1)
Exit Sub
End If
Else
Set newMenu = currMenuGroup.Menus.Add("辅助工具(&B)")
End If
Dim newMenuItem As Object ' AcadPopupMenuItem
' 添加一个菜单项到新的菜单中
Dim openMacro As String
' 指定宏字符串，该字符串相当于VB中的 "ESC ESC _open "
openMacro = Chr(3) & Chr(3) & "AutoPLCoordinate" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "自动标注(&A)", openMacro)
newMenuItem.helpString = "可以自动标注PL线的所在节点坐标"
' openMacro = Chr(3) & Chr(3) & "AutoPLCoordinate" & vbCr
' Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "自动标注(&A)", openMacro)
' newMenuItem.helpString = "可以自动标注PL线的所在节点坐标"
openMacro = Chr(3) & Chr(3) & "SeriesCoordinate" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "连续标注(&S)", openMacro)
newMenuItem.helpString = "可以手动选点标注所选点坐标"
openMacro = Chr(3) & Chr(3) & "ShowSetting" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "设置(&E)", openMacro)
newMenuItem.helpString = "可以设置一些参数"
openMacro = Chr(3) & Chr(3) & "DrawCoordinateGird" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "绘制坐标网格", openMacro)
newMenuItem.helpString = "绘制坐标网格"
openMacro = Chr(3) & Chr(3) & "ArctoPline" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "圆弧转多线段", openMacro)
newMenuItem.helpString = "圆弧转多线段"
openMacro = Chr(3) & Chr(3) & "SPLinetoPline1" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "样条转多线段1", openMacro)
newMenuItem.helpString = "样条转多线段1(等分法)"
openMacro = Chr(3) & Chr(3) & "SPLinetoPline2" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "样条转多线段2", openMacro)
newMenuItem.helpString = "样条转多线段2(等距法)"
openMacro = Chr(3) & Chr(3) & "PLine2DtoPline" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "二维多线转多线段", openMacro)
newMenuItem.helpString = "二维多线转多线段"
openMacro = Chr(3) & Chr(3) & "CombinedPL" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "合并多线段", openMacro)
newMenuItem.helpString = "合并多线段"
Set newMenuItem = newMenu.AddSeparator(newMenu.Count + 1)
'文字处理部分'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
openMacro = Chr(3) & Chr(3) & "CopyTextIncrement" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "增量复制", openMacro)
newMenuItem.helpString = "增量复制"
openMacro = Chr(3) & Chr(3) & "RotateText" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "批量旋转文字", openMacro)
newMenuItem.helpString = "批量旋转文字"
openMacro = Chr(3) & Chr(3) & "Pre_Suf_fix" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "前缀后缀", openMacro)
newMenuItem.helpString = "前缀后缀"
openMacro = Chr(3) & Chr(3) & "ShortenText" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "缩短文字", openMacro)
newMenuItem.helpString = "缩短文字"
openMacro = Chr(3) & Chr(3) & "T2MT" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Text转Mtext", openMacro)
newMenuItem.helpString = "Text转Mtext"
openMacro = Chr(3) & Chr(3) & "MT2T" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Mtext转Text", openMacro)
newMenuItem.helpString = "Mtext转Text"
openMacro = Chr(3) & Chr(3) & "LUcase" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "大小写转换", openMacro)
newMenuItem.helpString = "大小写转换"
openMacro = Chr(3) & Chr(3) & "CAD2Excel" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "CAD文字转Excel", openMacro)
newMenuItem.helpString = "CAD文字转Excel"
openMacro = Chr(3) & Chr(3) & "Excel2CAD" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Excel转CAD文字", openMacro)
newMenuItem.helpString = "Excel转CAD文字"
openMacro = Chr(3) & Chr(3) & "DataPrecision" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "数据精度", openMacro)
newMenuItem.helpString = "数据精度"
openMacro = Chr(3) & Chr(3) & "BatchCalc" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "批量计算", openMacro)
newMenuItem.helpString = "批量计算"
openMacro = Chr(3) & Chr(3) & "SumCalc" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "数值合并计算", openMacro)
newMenuItem.helpString = "数值合并计算"
openMacro = Chr(3) & Chr(3) & "MarkMax" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "标记最大值", openMacro)
newMenuItem.helpString = "标记最大值"
openMacro = Chr(3) & Chr(3) & "MarkMin" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "标记最小值", openMacro)
newMenuItem.helpString = "标记最小值"
openMacro = Chr(3) & Chr(3) & "AddTextBound" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "文本加框", openMacro)
newMenuItem.helpString = "文本加框"
openMacro = Chr(3) & Chr(3) & "TextParallelLine" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "字线平行", openMacro)
newMenuItem.helpString = "字线平行"
openMacro = Chr(3) & Chr(3) & "AlignText" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "对齐文本", openMacro)
newMenuItem.helpString = "对齐文本"
openMacro = Chr(3) & Chr(3) & "BreakText" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "打断文字", openMacro)
newMenuItem.helpString = "打断文字"
openMacro = Chr(3) & Chr(3) & "CombineText" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "合并文字", openMacro)
newMenuItem.helpString = "合并文字"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set newMenuItem = newMenu.AddSeparator(newMenu.Count + 1)
openMacro = Chr(3) & Chr(3) & "ShowAbout" & vbCr
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "关于", openMacro)
newMenuItem.helpString = "关于"
' 显示菜单到菜单栏中
newMenu.InsertInMenuBar (objCAD.MenuBar.Count + 1)
End Sub
这是我一个工程里的代码，你参考一下吧
补充：VB , VBA
