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

dyancai · 发表于 2005-5-10 08:10:00

用vba开发的一个小问题，怎样才能使自己设计的新菜单在点击时有反映，比如说点击新菜单的某一项时能够弹出一个自己设计好的窗体。
还有一个问题，如果要输出通过自己开发的小程序对图形文件进行操作产生的新对象的要素，比如直线的两个端点，长度等，该怎样设计。

cryyyy · 发表于 2005-5-10 08:35:00

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 · 发表于 2005-5-11 11:21:00

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

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

发表回复

精选推荐