各路高手帮帮忙，菜单操作问题

dyancai

用vba开发AutoCAD的一个小问题，怎样才能使自己设计的新菜单在点击时有反映，比如说点击新菜单的某一项时能够弹出一个自己设计好的窗体。


还有一个问题，如果要输出通过自己开发的小程序对图形文件进行操作产生的新对象的要素，比如直线的两个端点，长度等，该怎样设计。

cryyyy

Private Sub Command1_Click() '''这就是点击事件
Form012.Show '''通过点击,调用 form012 窗口
End If 第二个问题 要画线,我只知道一个比较简单的方法 就是定义出俩个点的坐标 格式如下: Dim ab As AcadLine ''''''''''''''
Dim startpointab(0 To 2) As Double
Dim endpointab(0 To 2) As Double
startpointab(0) = zbjl#: startpointab(1) = zxxsp + crf#: startpointab(2) = 0#
endpointab(0) = zbjl#: endpointab(1) = zxxsp - cra + 2#: endpointab(2) = 0#
Set ab = acadapp.ActiveDocument.ModelSpace.AddLine(startpointab, endpointab) startpoint 就是指起始点,endpoint 就是指 终点 它本身都是以三唯形式出现的,所以 每个点有三个坐标 偶也是超级大菜鸟 高手都不给我们解答这些菜菜的问题 555

lonelyhero

Public Sub AddToolMenu()
On Error GoTo ErrorCheatment
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0) ' If Not SafeGuard() Then Exit Sub Dim menuTool As AcadPopupMenu
Set menuTool = currMenuGroup.Menus.Add("隧道辅助(" & Chr(Asc("&")) & "S)") Dim macro As String
macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) Dim menuItemPlaneLayout As AcadPopupMenuItem
Set menuItemPlaneLayout = menuTool.AddMenuItem(menuTool.Count + 1, "平面图辅助", macro & "-vbarun" + Chr(32) + "PlaneLayout" + Chr(32))
menuItemPlaneLayout.HelpString = "平面图辅助设计" Dim menuItemSkiagraph As AcadPopupMenuItem
Set menuItemSkiagraph = menuTool.AddMenuItem(menuTool.Count + 1, "纵断面辅助", macro & "-vbarun" + Chr(32) + "Skiagraph" + Chr(32))
menuItemSkiagraph.HelpString = "纵断面图辅助设计" Dim menuItemEquipment As AcadPopupMenuItem
Set menuItemEquipment = menuTool.AddMenuItem(menuTool.Count + 1, "设备洞室辅助", macro & "-vbarun" + Chr(32) + "Equipment" + Chr(32))
menuItemEquipment.HelpString = "设备洞室辅助设计" menuTool.AddSeparator menuTool.Count + 1 Dim menuItemNo As AcadPopupMenuItem
Set menuItemNo = menuTool.AddMenuItem(menuTool.Count + 1, "通用图修改", macro & "-vbarun" + Chr(32) + "No" + Chr(32))
menuItemNo.HelpString = "通用图修改" menuTool.AddSeparator menuTool.Count + 1 Dim menuItemCalculateLength As AcadPopupMenuItem
Set menuItemCalculateLength = menuTool.AddMenuItem(menuTool.Count + 1, "计算长度", macro & "-vbarun" + Chr(32) + "CalculateLen" + Chr(32))
menuItemCalculateLength.HelpString = "计算并标注钢筋等的长度"
Dim menuItemCalculateArea As AcadPopupMenuItem
Set menuItemCalculateArea = menuTool.AddMenuItem(menuTool.Count + 1, "计算面积", macro & "-vbarun" + Chr(32) + "CalculateArea" + Chr(32))
menuItemCalculateArea.HelpString = "计算封闭单联通区域的面积"
Dim menuItemVCurve As AcadPopupMenuItem
Set menuItemVCurve = menuTool.AddMenuItem(menuTool.Count + 1, "竖曲线高程计算", macro & "-vbarun" + Chr(32) + "CalculateVCurve" + Chr(32))
menuItemVCurve.HelpString = "竖曲线高程计算"
Dim menuSeparator As AcadPopupMenuItem
Set menuSeparator = menuTool.AddSeparator(menuTool.Count + 1)
Dim menuItemSlopeLabel As AcadPopupMenuItem
Set menuItemSlopeLabel = menuTool.AddMenuItem(menuTool.Count + 1, "标注坡度", macro & "-vbarun" + Chr(32) + "SlopeLabel" + Chr(32))
menuItemSlopeLabel.HelpString = "计算并标注坡度"
Dim menuItemElevationLabel As AcadPopupMenuItem
Set menuItemElevationLabel = menuTool.AddMenuItem(menuTool.Count + 1, "标注标高", macro & "-vbarun" + Chr(32) + "DrawElevation" + Chr(32))
menuItemElevationLabel.HelpString = "计算并标注标高"
Dim menuItemSection As AcadPopupMenuItem
Set menuItemSection = menuTool.AddMenuItem(menuTool.Count + 1, "画剖面线...", macro & "-vbarun" + Chr(32) + "DrawSectionLine" + Chr(32))
menuItemSection.HelpString = "对齐对象"
Dim menuItem1 As AcadPopupMenuItem
Set menuItem1 = menuTool.AddMenuItem(menuTool.Count + 1, "画断开线", macro & "-vbarun" + Chr(32) + "DrawBreakLine" + Chr(32))
menuItem1.HelpString = "画断开线"
Dim menuGeneralOffset As AcadPopupMenuItem
Set menuGeneralOffset = menuTool.AddMenuItem(menuTool.Count + 1, "广义偏移", macro & "-vbarun" + Chr(32) + "GeneralOffset" + Chr(32))
menuGeneralOffset.HelpString = "广义偏移" Dim menuDrawBlock As AcadPopupMenuItem
Set menuDrawBlock = menuTool.AddMenuItem(menuTool.Count + 1, "等距离画块", macro & "-vbarun" + Chr(32) + "DrawBlock" + Chr(32))
menuDrawBlock.HelpString = "对线串等距离画块" Dim menuMoveText As AcadPopupMenuItem
Set menuMoveText = menuTool.AddMenuItem(menuTool.Count + 1, "选择并移动文本对象", macro & "-vbarun" + Chr(32) + "MoveText" + Chr(32))
menuMoveText.HelpString = "对线串等距离画块" Dim menuStretchText As AcadPopupMenuItem
Set menuStretchText = menuTool.AddMenuItem(menuTool.Count + 1, "拉伸文本对象", macro & "-vbarun" + Chr(32) + "StretchText" + Chr(32))
menuStretchText.HelpString = "对线串等距离画块" Dim menuReplaceElev As AcadPopupMenuItem
Set menuReplaceElev = menuTool.AddMenuItem(menuTool.Count + 1, "标高替换", macro & "-vbarun" + Chr(32) + "ReplaceElev" + Chr(32))
menuReplaceElev.HelpString = "对线串等距离画块" Dim menuReplaceText As AcadPopupMenuItem
Set menuReplaceText = menuTool.AddMenuItem(menuTool.Count + 1, "文字替换", macro & "-vbarun" + Chr(32) + "ReplaceText" + Chr(32))
menuReplaceText.HelpString = "对线串等距离画块" menuTool.AddSeparator menuTool.Count + 1
Dim menuItemAlign As AcadPopupMenuItem
Set menuItemAlign = menuTool.AddMenuItem(menuTool.Count + 1, "对齐...", macro & "-vbarun" + Chr(32) + "AlignEnt" + Chr(32))
menuItemAlign.HelpString = "对齐对象"
menuTool.AddSeparator menuTool.Count + 1 Dim menuItemBatchPlot As AcadPopupMenuItem
Set menuItemBatchPlot = menuTool.AddMenuItem(menuTool.Count + 1, "批处理打印...", macro & "-vbarun" + Chr(32) + "BatchPlot" + Chr(32))
menuItemBatchPlot.HelpString = "成批打印各个布局" ' menuTool.AddSeparator menuTool.Count + 1
'
' Set menuItemLoadVentilationModule = menuTool.AddMenuItem(menuTool.Count + 1, "加载公路隧道通风与照明设计模块", macro & "-vbarun" + Chr(32) + "LoadVentilationModule" + Chr(32))
' menuItemLoadVentilationModule.HelpString = "加载公路隧道通风与照明设计模块" menuTool.InsertInMenuBar ThisDrawing.Application.MenuBar.Count STRVBAPATH = ThisDrawing.Application.VBE.activevbproject.FileName
Dim i As Integer
i = 1
While InStr(i, STRVBAPATH, "\") <> 0
i = InStr(i, STRVBAPATH, "\") + 1
Wend
STRVBAPATH = Left(STRVBAPATH, i - 1) + "ConfigFiles\"
Exit Sub ErrorCheatment:
Err.Clear
End Sub Sub CalculateLen()
frmCalculateLen.Show
End Sub Sub CalculateArea()
frmCalculateArea.Show
End Sub Sub GeneralOffset()
frmOffset.Show
End Sub Sub DrawBlock()
frmDrawBlock.Show
End Sub Sub CalculateVCurve()
frmVCurve.Show
End Sub Sub Section()
frmCrossSection.Show
End Sub Sub LoadVentilationModule()
On Error Resume Next
' LoadDVB GetVBAPath() & "Tunnel20050404.dvb"
' RunMacro GetVBAPath() & "Tunnel20050404.dvb!ThisDrawing.AddSubMenu"
' menuItemLoadVentilationModule.Enable = False
End Sub Sub SlopeLabel()
frmSlopeLabel.Show
End Sub Sub PlaneLayout()
frmPlaneLayout.Show
End Sub Sub Skiagraph()
frmSkiagraph.Show
End Sub Sub Equipment()
frmEquipment.Show
End Sub