各路高手帮帮忙，菜单操作问题
用vba开发autocad的一个小问题，怎样才能使自己设计的新菜单在点击时有反映，比如说点击新菜单的某一项时能够弹出一个自己设计好的窗体。还有一个问题，如果要输出通过自己开发的小程序对图形文件进行操作产生的新对象的要素，比如直线的两个端点，长度等，该怎样设计。 Private Sub Command1_Click() '''这就是点击事件 <BR>Form012.Show '''通过点击,调用 form012 窗口<BR>End If
第二个问题
要画线,我只知道一个比较简单的方法
就是定义出俩个点的坐标
格式如下:
Dim ab As AcadLine ''''''''''''''<BR>Dim startpointab(0 To 2) As Double<BR>Dim endpointab(0 To 2) As Double<BR>startpointab(0) = zbjl#: startpointab(1) = zxxsp + crf#: startpointab(2) = 0#<BR>endpointab(0) = zbjl#: endpointab(1) = zxxsp - cra + 2#: endpointab(2) = 0#<BR>Set ab = acadapp.ActiveDocument.ModelSpace.AddLine(startpointab, endpointab)
startpoint 就是指起始点,endpoint 就是指 终点
它本身都是以三唯形式出现的,所以 每个点有三个坐标
偶也是超级大菜鸟
高手都不给我们解答这些菜菜的问题
555
Public Sub AddToolMenu()<BR> On Error GoTo ErrorCheatment<BR> Dim currMenuGroup As AcadMenuGroup<BR> Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
' If Not SafeGuard() Then Exit Sub
Dim menuTool As AcadPopupMenu<BR> Set menuTool = currMenuGroup.Menus.Add("隧道辅助(" & Chr(Asc("&")) & "S)")
Dim macro As String<BR> macro = Chr(vbKeyEscape) + Chr(vbKeyEscape)
Dim menuItemPlaneLayout As AcadPopupMenuItem<BR> Set menuItemPlaneLayout = menuTool.AddMenuItem(menuTool.Count + 1, "平面图辅助", macro & "-vbarun" + Chr(32) + "PlaneLayout" + Chr(32))<BR> menuItemPlaneLayout.HelpString = "平面图辅助设计"
Dim menuItemSkiagraph As AcadPopupMenuItem<BR> Set menuItemSkiagraph = menuTool.AddMenuItem(menuTool.Count + 1, "纵断面辅助", macro & "-vbarun" + Chr(32) + "Skiagraph" + Chr(32))<BR> menuItemSkiagraph.HelpString = "纵断面图辅助设计"
Dim menuItemEquipment As AcadPopupMenuItem<BR> Set menuItemEquipment = menuTool.AddMenuItem(menuTool.Count + 1, "设备洞室辅助", macro & "-vbarun" + Chr(32) + "Equipment" + Chr(32))<BR> menuItemEquipment.HelpString = "设备洞室辅助设计"
menuTool.AddSeparator menuTool.Count + 1
Dim menuItemNo As AcadPopupMenuItem<BR> Set menuItemNo = menuTool.AddMenuItem(menuTool.Count + 1, "通用图修改", macro & "-vbarun" + Chr(32) + "No" + Chr(32))<BR> menuItemNo.HelpString = "通用图修改"
menuTool.AddSeparator menuTool.Count + 1
Dim menuItemCalculateLength As AcadPopupMenuItem<BR> Set menuItemCalculateLength = menuTool.AddMenuItem(menuTool.Count + 1, "计算长度", macro & "-vbarun" + Chr(32) + "CalculateLen" + Chr(32))<BR> menuItemCalculateLength.HelpString = "计算并标注钢筋等的长度"<BR> Dim menuItemCalculateArea As AcadPopupMenuItem<BR> Set menuItemCalculateArea = menuTool.AddMenuItem(menuTool.Count + 1, "计算面积", macro & "-vbarun" + Chr(32) + "CalculateArea" + Chr(32))<BR> menuItemCalculateArea.HelpString = "计算封闭单联通区域的面积"<BR> Dim menuItemVCurve As AcadPopupMenuItem<BR> Set menuItemVCurve = menuTool.AddMenuItem(menuTool.Count + 1, "竖曲线高程计算", macro & "-vbarun" + Chr(32) + "CalculateVCurve" + Chr(32))<BR> menuItemVCurve.HelpString = "竖曲线高程计算"<BR> Dim menuSeparator As AcadPopupMenuItem<BR> Set menuSeparator = menuTool.AddSeparator(menuTool.Count + 1)
<BR> Dim menuItemSlopeLabel As AcadPopupMenuItem<BR> Set menuItemSlopeLabel = menuTool.AddMenuItem(menuTool.Count + 1, "标注坡度", macro & "-vbarun" + Chr(32) + "SlopeLabel" + Chr(32))<BR> menuItemSlopeLabel.HelpString = "计算并标注坡度"<BR> Dim menuItemElevationLabel As AcadPopupMenuItem<BR> Set menuItemElevationLabel = menuTool.AddMenuItem(menuTool.Count + 1, "标注标高", macro & "-vbarun" + Chr(32) + "DrawElevation" + Chr(32))<BR> menuItemElevationLabel.HelpString = "计算并标注标高"<BR> Dim menuItemSection As AcadPopupMenuItem<BR> Set menuItemSection = menuTool.AddMenuItem(menuTool.Count + 1, "画剖面线...", macro & "-vbarun" + Chr(32) + "DrawSectionLine" + Chr(32))<BR> menuItemSection.HelpString = "对齐对象"<BR> Dim menuItem1 As AcadPopupMenuItem<BR> Set menuItem1 = menuTool.AddMenuItem(menuTool.Count + 1, "画断开线", macro & "-vbarun" + Chr(32) + "DrawBreakLine" + Chr(32))<BR> menuItem1.HelpString = "画断开线"
<BR> Dim menuGeneralOffset As AcadPopupMenuItem<BR> Set menuGeneralOffset = menuTool.AddMenuItem(menuTool.Count + 1, "广义偏移", macro & "-vbarun" + Chr(32) + "GeneralOffset" + Chr(32))<BR> menuGeneralOffset.HelpString = "广义偏移"
Dim menuDrawBlock As AcadPopupMenuItem<BR> Set menuDrawBlock = menuTool.AddMenuItem(menuTool.Count + 1, "等距离画块", macro & "-vbarun" + Chr(32) + "DrawBlock" + Chr(32))<BR> menuDrawBlock.HelpString = "对线串等距离画块"
Dim menuMoveText As AcadPopupMenuItem<BR> Set menuMoveText = menuTool.AddMenuItem(menuTool.Count + 1, "选择并移动文本对象", macro & "-vbarun" + Chr(32) + "MoveText" + Chr(32))<BR> menuMoveText.HelpString = "对线串等距离画块"
Dim menuStretchText As AcadPopupMenuItem<BR> Set menuStretchText = menuTool.AddMenuItem(menuTool.Count + 1, "拉伸文本对象", macro & "-vbarun" + Chr(32) + "StretchText" + Chr(32))<BR> menuStretchText.HelpString = "对线串等距离画块"
Dim menuReplaceElev As AcadPopupMenuItem<BR> Set menuReplaceElev = menuTool.AddMenuItem(menuTool.Count + 1, "标高替换", macro & "-vbarun" + Chr(32) + "ReplaceElev" + Chr(32))<BR> menuReplaceElev.HelpString = "对线串等距离画块"
Dim menuReplaceText As AcadPopupMenuItem<BR> Set menuReplaceText = menuTool.AddMenuItem(menuTool.Count + 1, "文字替换", macro & "-vbarun" + Chr(32) + "ReplaceText" + Chr(32))<BR> menuReplaceText.HelpString = "对线串等距离画块"
menuTool.AddSeparator menuTool.Count + 1
<BR> Dim menuItemAlign As AcadPopupMenuItem<BR> Set menuItemAlign = menuTool.AddMenuItem(menuTool.Count + 1, "对齐...", macro & "-vbarun" + Chr(32) + "AlignEnt" + Chr(32))<BR> menuItemAlign.HelpString = "对齐对象"
<BR> menuTool.AddSeparator menuTool.Count + 1
Dim menuItemBatchPlot As AcadPopupMenuItem<BR> Set menuItemBatchPlot = menuTool.AddMenuItem(menuTool.Count + 1, "批处理打印...", macro & "-vbarun" + Chr(32) + "BatchPlot" + Chr(32))<BR> menuItemBatchPlot.HelpString = "成批打印各个布局"
' menuTool.AddSeparator menuTool.Count + 1<BR>'<BR>' Set menuItemLoadVentilationModule = menuTool.AddMenuItem(menuTool.Count + 1, "加载公路隧道通风与照明设计模块", macro & "-vbarun" + Chr(32) + "LoadVentilationModule" + Chr(32))<BR>' menuItemLoadVentilationModule.HelpString = "加载公路隧道通风与照明设计模块"
menuTool.InsertInMenuBar ThisDrawing.Application.MenuBar.Count
STRVBAPATH = ThisDrawing.Application.VBE.activevbproject.FileName<BR> Dim i As Integer<BR> i = 1<BR> While InStr(i, STRVBAPATH, "\") <> 0<BR> i = InStr(i, STRVBAPATH, "\") + 1<BR> Wend<BR> STRVBAPATH = Left(STRVBAPATH, i - 1) + "ConfigFiles\"<BR> Exit Sub
ErrorCheatment:<BR> Err.Clear<BR>End Sub
Sub CalculateLen()<BR> frmCalculateLen.Show<BR>End Sub
Sub CalculateArea()<BR> frmCalculateArea.Show<BR>End Sub
Sub GeneralOffset()<BR> frmOffset.Show<BR>End Sub
Sub DrawBlock()<BR> frmDrawBlock.Show<BR>End Sub
Sub CalculateVCurve()<BR> frmVCurve.Show<BR>End Sub
Sub Section()<BR> frmCrossSection.Show<BR>End Sub
Sub LoadVentilationModule()<BR> On Error Resume Next<BR>' LoadDVB GetVBAPath() & "Tunnel20050404.dvb"<BR>' RunMacro GetVBAPath() & "Tunnel20050404.dvb!ThisDrawing.AddSubMenu"<BR>' menuItemLoadVentilationModule.Enable = False<BR>End Sub
Sub SlopeLabel()<BR> frmSlopeLabel.Show<BR>End Sub
Sub PlaneLayout()<BR> frmPlaneLayout.Show<BR>End Sub
Sub Skiagraph()<BR> frmSkiagraph.Show<BR>End Sub
Sub Equipment()<BR> frmEquipment.Show<BR>End Sub<BR>
页:
[1]