VB开发CAD菜单

VB能实现cad菜单 2010年09月16日 星期四 下午 07:42Public Sub CreateMenu()On Error Resume Next用AutoCAD菜单组的第一项创建一个菜单组Dim CurMenuGroup As ObjectSet CurMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)创建一个名为“CAD增强插件”的菜单项，设S为加速键Dim NewMenu As ObjectSet NewMenu = CurMenuGroup.Menus.Add(CAD增强插件( + Chr(Asc(&) + S)确定选择项的宏Dim FlowMacro As String为宏分配命令即VBA中的 ESC ESC 设计流程FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & DefPipeSize & Chr(34) & ) & Chr(13)添加选择项到CAD增强插件菜单项中Dim FlowMenuItem As ObjectDim SepaMenuItem As Object 分隔符Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 插入页码, FlowMacro)Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)创建子菜单Dim SingleMenu As ObjectSet SingleMenu = NewMenu.AddSubMenu(NewMenu.Count + 1, 横断面修改)将选择项添加到子菜单中Dim SubMenuItem As ObjectDim SubMacro As StringSubMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & Start_HdmBz & Chr(34) & ) & Chr(13)Set SubMenuItem = SingleMenu.AddMenuItem(SingleMenu.Count + 1, 横断面高程标注 , SubMacro)Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)即VBA中的 ESC ESC 设计流程FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & AboutUs & Chr(34) & ) & Chr(13)Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 关于, FlowMacro)FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & SetOption & Chr(34) & ) & Chr(13)Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 设置, FlowMacro)在AutoCAd菜单条上显示新创建的菜单NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)End Sub*Public Sub CreateMenu()On Error Resume Next用AutoCAD菜单组的第一项创建一个菜单组Dim CurMenuGroup As ObjectSet CurMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)创建一个名为“CAD增强插件”的菜单项，设S为加速键Dim NewMenu As ObjectSet NewMenu = CurMenuGroup.Menus.Add(CAD增强插件( + Chr(Asc(&) + S)确定选择项的宏Dim FlowMacro As String为宏分配命令即VBA中的 ESC ESC 设计流程FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & DefPipeSize & Chr(34) & ) & Chr(13)添加选择项到CAD增强插件菜单项中Dim FlowMenuItem As ObjectDim SepaMenuItem As Object 分隔符Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 插入页码, FlowMacro)Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)创建子菜单Dim SingleMenu As ObjectSet SingleMenu = NewMenu.AddSubMenu(NewMenu.Count + 1, 横断面修改)将选择项添加到子菜单中Dim SubMenuItem As ObjectDim SubMacro As StringSubMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & Start_HdmBz & Chr(34) & ) & Chr(13)Set SubMenuItem = SingleMenu.AddMenuItem(SingleMenu.Count + 1, 横断面高程标注 , SubMacro)Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)即VBA中的 ESC ESC 设计流程FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & AboutUs & Chr(34) & ) & Chr(13)Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 关于, FlowMacro)FlowMacro = Chr(3) & Chr(3) & (vl-vbarun & Chr(34) & SetOption & Chr(34) & ) & Chr(13)Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc(&) + 设置, FlowMacro)在AutoCAd菜单条上显示新创建的菜单NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)End Sub*用VB给ACAD添加菜单，调用EXE-我用VB给ACAD添加菜单，调用绘中心线。EXE，在执行中，总是先启动DOS命令窗口，怎么才能使其不显示，就象绘中心线功能是CAD自己的一样。Sub Main()Dim acadapp As AcadApplicationOn Error Resume NextSet acadapp = GetObject(, Autocad.Application.16)If Err ThenErr.ClearSet acadapp = CreateObject(Autocad.Application.16)If Err ThenMsgBox (不能运行ACAD，请检查是否安装了ACAD)Exit SubEnd IfEnd Ifacadapp.Visible = TrueDim acaddoc As AcadDocumentSet acaddoc = acadapp.ActiveDocumentDim curlayerobj As ObjectSet curlayerobj = acaddoc.ActiveLayerDim lineEnt As AcadLineTypeDim found As Booleanfound = FalseFor Each lineEnt In acaddoc.LinetypesIf StrComp(lineEnt.Name, DASHDOTX2, 1) = 0 Thenfound = TrueExit ForEnd IfNextIf Not (found) Thenacaddoc.Linetypes.Load DASHDOTX2, acad.linEnd IfSet newlayerObj = acaddoc.Layers.Add(aidLayer)acaddoc.ActiveLayer = newlayerObjnewlayerObj.Color = acGreennewlayerObj.Linetype = DASHDOTX2获得轴线的两个端点Dim lsPnt As VariantDim lePnt As VariantDim aixlineObj As AcadLinelsPnt = acaddoc.Utility.GetPoint(, 输入第一点：)lePnt = acaddoc.Utility.GetPoint(, 输入第二点：)Set aixlineObj = acaddoc.ModelSpace.AddLine(lsPnt, lePnt)Dim midPnt(0 To 2) As DoublemidPnt(0) = (lsPnt(0) + lePnt(0) / 2mi