2023年12月23日发(作者:)

大家知道什么是宏吗?说白它就是VBA过程。看下面的代码:PublicSubMacroDemo()MsgBox"Hello,WelcometoAutoCADVBA!"EndSub这就是宏。打开CAD输入命令vbaide回车会出现VBA的编辑界面,双击ThisDrawing在右侧的代码区输入上面的代码。如下图:然后按F5键会出现宏窗口,如下图:点击运行,大家看到什么?这就是一个最简单的一个用VBA对CAD进行二次开发的程序,也就是宏那什么是VBA呢?VBA就是VB的一个子集它的全称是VisualBasicForApplication,它具有VB的大部分功能。既然我们选择了VBA,我们首先要知道VBA能操作CAD里的哪些对象呢?打开VBAIDE窗口按下F2键会出现对象浏览器。如下图

库选择AutoCAD,这时下面显示的就是CAD为VBA提供的可操作的对象的类了。这时有的人因没有基础,所以还是一头雾水,别怕,选中一个类图标后按F1,这时会弹出AutoCADActiveXandVBAReference,选择最上面的一个子项ObjectModel(对象模型),这个就是在CAD里那些对象的关系,如下图:如果英文不好的话,可以安装CAD2000,它的这个部分是中文的。为想学好VBA二次开发这个是必需的,而且VBA对Office的二次开发也是这样的。这个在编程界叫做ActiveX,包括ActiveX控件、ActiveXDLL、和ActiveXEXE就好比一个程序为其它程序提供的一个后门一样下面我就给大家讲一下菜单吧。因为我们用到的其它公司做CAD二次开发的插件,从直观上首先接触的就是它的菜单,刚开始用的时候就是从它的菜单开始接触的。我经常用到的做菜单的方法有两种,一种是用CAD的菜单文件,另一种就是用VBA代码直接长成菜单。

我先介绍第一种,CAD的菜单文件它是文本文件,我们用记事本就可打开并编辑它,或者再重新创建一个说到这里有的人可能要问了,我应该从何处开始入手呢,要怎样做呢?别急,CAD本身就有现成的供我们参考,就放在CAD的安装文件夹下的Support文件夹内,或者其它插件的文件夹内,找不到可以按F3搜一下,扩展名分别为.,mnc默认的菜单文件是。原始ASCII菜单文件,即用户通常编辑或创建的文件。该文件以查看完整菜单文件的外表特征。.mnc已编译的菜单文件;一种二进制文件,包含用于定义菜单或其他界面元素的功能及外观的命令字符串和菜单语法。首次加载MNU文件时,AutoCAD将编译此文件。.mns源菜单文件;一种与MNU文件相同的ASCII文件,但是不包含注释或特殊格式。每次菜单文件的内容被更改时,AutoCAD将修改源菜单文件。.mnr菜单资源文件;一种二进制文件,包含由菜单或其他界面元素使用的位图。AutoCAD每次编译MNC文件时,均生成菜单资源文件。.mnt菜单资源文件。仅在MNR文件无效(例如,只读)时生成该文件。.mnl菜单LISP文件;包含菜单文件使用的AutoLISP表达式。当加载与菜单LISP文件具有相同文件名的菜单文件时,AutoCAD会将菜单LISP文件加载至内存。自己做的.mns的文件内容如下////AutoCAD菜单文件-C:Documentsan//***MENUGROUP=wyp***POP1**WYPID_COMPUTE[富地2004(&C)]ID_TongXin[通信...CTRL+SHIFT+A]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/通信.dvb!nID_WorkAffiliation[工作联系单...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!filiationID_StyleBook[样本查询...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!ookID_DRAW[->绘图工具]ID_ZISZERO[多义线各节点Z轴设为零]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/Z轴为!0ID_LuoXuanXian[三维螺旋线...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/螺旋线.dvb!nXianID_JKX[<-渐开线齿轮...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/渐开线.dvb!_DesignTools[->设计工具]ID_MXB[导出明细表...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba

计算/!_YGXCKDGS[圆管型材宽度估算...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/圆管型材宽度估算.dvb!GSID_BKJQJS[圆管型材宽度精算...CTRL+SHIFT+S]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/圆管型材宽度精算.dvb!ID_NDJS[挠度计算...CTRL+SHIFT+C]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/挠度计算.dvb!_BULK1[体积...CTRL+SHIFT+Z]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/体积.dvb!_LianLun[链轮参数]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/链轮参数.dvb!nID_YLGBHJS[压力管壁厚计算...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/压力管壁厚计算.dvb!SID_GTBHJS[缸筒壁厚计算...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/缸筒壁厚计算.dvb!ID_Bearing[轴承型号大全...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!gID_LiuLiang[油缸流量计算]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/流量计算.dvb!ngID_YYZHDJGL[液压站电机功率计算]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!GLid_GearMatching[<-齿轮幅齿数匹配...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!tchingID_CADSysOption[->CAD系统设置]ID_MButton[->鼠标中键控制]ID_MButtonPan[鼠标中键平移]^C^C_setvarmbuttonpan1ID_MButtonMenu[<-鼠标中键菜单]^C^C_setvarmbuttonpan0ID_ANGDIR[->设置正角度的方向]ID_anticlockwise[逆时针]^C^C_setvarANGDIR0ID_deasil[<-顺时针]^C^C_setvarANGDIR1ID_extendMode[->隐含边延伸模式]ID_extend[延伸(&E)]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!ID_NoExtend[<-不延伸(&N)]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!ndID_filedia[->显示文件对话框]ID_filediaON[显示]^C^C_setvarfiledia1ID_filediaOFF[<-不显示]^C^C_setvarfiledia0ID_PROJMODE[->设置修剪和延伸的当前“投影”模式]ID_PROJMODE0[真三维模式(无投影)]^C^C_setvarPROJMODE0ID_PROJMODE1[投影到当前UCS的XY平面上]^C^C_setvarPROJMODE1ID_PROJMODE2[<-投影到当前视图平面]^C^C_setvarPROJMODE2ID_RASTERPREVIEW[->预览图像是否随图形一起保存]ID_RASTERPREVIEWOFF[不创建预览图像]^C^C_setvarRASTERPREVIEW0

ID_RASTERPREVIEWON[<-创建预览图像]^C^C_setvarRASTERPREVIEW1ID_REPORTERROR[->寄出错误报告到]ID_REPORTERRORON[显示]^C^C_setvarREPORTERROR1ID_REPORTERROROFF[<-不显示]^C^C_setvarREPORTERROR0ID_PICKSTYLE[->双击鼠标编辑对象]ID_PICKSTYLE_OK[使用]^C^C_setvarPICKSTYLE0ID_PICKSTYLE_NO[<-不使用]^C^C_setvarPICKSTYLE1ID_ANGBASE[基准角置零,图案为Ansi31]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!eIs0ID_ZOOMFACTOR[鼠标辊抡缩放速度...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/鼠标辊抡缩放速度.dvb!_HPNAME[设置默认填充图案为ANSI31]^C^C_setvarHPNAMEansi31ID_CELTSCALE[设置当前对象的线型比例因子为1]^C^C_setvarCELTSCALE1ID_QLHCHBC[<-清理、核查、缩放并保存CTRL+ALT+Q]^C^C-purgea*n_audityzoomeqsaveID_WinOption[->Windows系统工具]ID_CALC[计算器...CTRL+SHIFT+ALT+Z]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!_Mspaint[画笔...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!tID_CALC1[实用计算器...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!1ID_ChangeWPaper[<-更换系统桌面...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!perChangerID_Tel[->电话表]ID_FDTel[公司电话表...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!D_ZHGTel[<-重工电话表...]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!ID_Menu[->菜单]ID_Update[CAD2002菜单更新]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!02menuID_Update04[<-CAD2004菜单更新]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/!04menu***TOOLBARS**TOOLBARWYPID_ToolbarWYP_0[_Toolbar("ToolbarWyp",_Top,_Show,0,2,1)]ID_OsnapCent[_Button("捕捉到圆心","RCDATA_16_OSNCEN","RCDATA_16_OSNCEN")]_cenID_OsnapTang[_Button("捕捉到切点","RCDATA_16_OSNTAN","RCDATA_16_OSNTAN")]_tanID_PCCAD_PCZXX_0[_Button("中心线ZX","//","")]^P^C^CPC_zXXT

[--]ID_Circle2pt_0[_Button("圆两点","RCDATA_16_CIR2PT","RCDATA_16_CIR2PT")]^C^C_circle_2pID_3dpoly_0[_Button("三维多段线","RCDATA_16_3DPOLY","RCDATA_16_3DPOLY")]^C^C_3dpolyID_Hatchedit_0[_Button("编辑图案填充","RCDATA_16_HATEDI","RCDATA_16_HATEDI")]^C^C_hatcheditID_Region_0[_Button("面域","RCDATA_16_REGION","RCDATA_16_REGION")]^C^C_region[--]ID_Sphere_0[_Button("球体","RCDATA_16_SPHERE","RCDATA_16_SPHERE")]^C^C_sphereID_Extrude_0[_Button("拉伸","RCDATA_16_EXTRUD","RCDATA_16_EXTRUD")]^C^C_extrudeID_Revolve_0[_Button("旋转","RCDATA_16_REVOLV","RCDATA_16_REVOLV")]^C^C_revolveID_Slice_0[_Button("剖切","RCDATA_16_SLICE","RCDATA_16_SLICE")]^C^C_slice[--]ID_Union_0[_Button("并集","RCDATA_16_UNION","RCDATA_16_UNION")]^C^C_unionID_Subtract_0[_Button("差集","RCDATA_16_SUBTRA","RCDATA_16_SUBTRA")]^C^C_subtractID_Intersect_0[_Button("交集","RCDATA_16_INTERS","RCDATA_16_INTERS")]^C^C_intersectID_FaceExtru_0[_Button("拉伸面","RCDATA_16_EXTRUD","RCDATA_16_EXTRUD")]^C^C_solidedit_face_extrudeID_Shell_0[_Button("抽壳","RCDATA_16_SHELL","RCDATA_16_SHELL")]^C^C_solidedit_body_shell[--]ID_Massprop_0[_Button("面域/质量特性","RCDATA_16_MASSPR","RCDATA_16_MASSPR")]^C^C_masspropID_UBBulk_0[_Button("体积","","ICON_16_BLANK")]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/体积.dvb![--]ID_2doptim_0[_Button("二维线框","RCDATA_16_2DOPTIM","RCDATA_16_2DOPTIM")]$M=$(if,$(and,$(eq,$(getvar,tilemode),0),$(eq,$(getvar,cvport),1)),^C^C_shademode,^C^C_shademode_2)ID_Wireframe_0[_Button("三维线框","RCDATA_16_WIREFRAME","RCDATA_16_WIREFRAME")]$M=$(if,$(and,$(eq,$(getvar,tilemode),0),$(eq,$(getvar,cvport),1)),^C^C_shademode,^C^C_shademode_3)ID_Hidden_0[_Button("消隐","RCDATA_16_HIDDEN","RCDATA_16_HIDDEN")]$M=$(if,$(and,$(eq,$(getvar,tilemode),0),$(eq,$(getvar,cvport),1)),^C^C_shademode,^C^C_shademode_h)ID_Gouraud_0[_Button("体着色","RCDATA_16_GOURAUD",

"RCDATA_16_GOURAUD")]$M=$(if,$(and,$(eq,$(getvar,tilemode),0),$(eq,$(getvar,cvport),1)),^C^C_shademode,^C^C_shademode_g)ID_UBZIs0[_Button("UserDefinedButton","","ICON_16_BLANK")]^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/Z轴为!0[--]ID_Dimlinear[_Button("线性标注","RCDATA_16_DIMLIN","RCDATA_16_DIMLIN")]^C^C_dimlinearID_DimUpdate[_Button("标注更新","RCDATA_16_DIMUPD","RCDATA_16_DIMUPD")]^C^C_-dimstyle_apply[--]ID_TbViewpoi_0[_Flyout("视图",RCDATA_16_DDVIEW,RCDATA_16_DDVIEW,_OtherIcon,_VIEWPOINT)]ID_ZoomExten_0[_Button("范围缩放","RCDATA_16_ZOOEXT","RCDATA_16_ZOOEXT")]'_zoom_e[--]ID_UserButton_1[_Button("清理、核查、缩放并保存","","RCDATA_16_BLANK")]^C^C-purgea*n_audityzoomeqsave[--]ID_3darray_0[_Button("三维阵列","","RCDATA_16_BLANK")]^C^C_3darrayID_Mirror3d_0[_Button("三维镜像","","RCDATA_16_BLANK")]^C^C_mirror3dID_Rotate3d_0[_Button("三维旋转","","RCDATA_16_BLANK")]^C^C_rotate3d***ACCELERATORSID_BULK1[CONTROL+SHIFT+"Z"]ID_PCCAD_PCZXX_0[CONTROL+ALT+TOOLBAR+"Z"]ID_BKJQJS[CONTROL+SHIFT+"S"]ID_CALC[CONTROL+SHIFT+ALT+"Z"]ID_UserButton_1[CONTROL+SHIFT+TOOLBAR+"X"]ID_QLHCHBC[CONTROL+ALT+"Q"]ID_TongXin[CONTROL+SHIFT+"A"]***HELPSTRINGSID_UPDATE[更新计算菜单]ID_GTBHJS[缸筒管壁厚计算...]ID_REVOLVE_0[绕轴旋转二维对象以创建实体:REVOLVE]ID_SHELL_0[以指定的厚度在实体对象上创建中空的薄壁:SOLIDEDIT]ID_BULK1[计算基本几何体的体积]ID_SLICE_0[用平面剖切一组实体:SLICE]ID_SUBTRACT_0[用差集创建组合面域或实体:SUBTRACT]

ID_DIMLINEAR[创建线性标注:DIMLINEAR]ID_UBZIS0[将多义线各节点Z轴设为零]ID_SPHERE_0[创建三维实心球体:SPHERE]ID_JKX[渐开线...]ID_HATCHEDIT_0[修改现有的图案填充对象:HATCHEDIT]ID_UBBULK_0[计算基本几何体的体积]ID_FACEEXTRU_0[按指定高度或沿路径拉伸实体对象的选定面:SOLIDEDIT]ID_CIRCLE2PT_0[用直径的两个端点创建圆:CIRCLE]ID_REGION_0[将包含封闭区域的对象转换为面域对象:REGION]ID_ZISZERO[将多义线各节点Z轴设为零]ID_HIDDEN_0[将视口设置为隐藏线:SHADEMODE]ID_INTERSECT_0[从实体或面域的交集创建组合实体或面域:INTERSECT]ID_DIMUPDATE[更新标注的样式:DIMSTYLE]ID_NDJS[挠度计算...CTRL+SHIFT+C]ID_2DOPTIM_0[将视口设置为二维线框:SHADEMODE]ID_OSNAPCENT[捕捉到圆弧、圆、椭圆或椭圆弧的中心点:CEN]ID_OSNAPTANG[捕捉到圆弧、圆、椭圆、椭圆弧或样条曲线的切点:TAN]ID_MIRROR3D_0[创建对象相对于某一平面的镜像图像副本:MIRROR3D]ID_3DARRAY_0[创建三维阵列:3DARRAY]ID_LIANLUN[链轮参数计算...]ID_MASSPROP_0[计算并显示面域或实体的质量特性:MASSPROP]ID_ZOOMEXTEN_0[显示图形范围:ZOOM]ID_LUOXUANXIAN[三维螺旋线...]ID_YGXCKDGS[圆管型材宽度估算...]ID_BKJQJS[圆管型材宽度精算...CTRL+SHIFT+S]ID_USERBUTTON_0[用户定义的按钮]ID_WIREFRAME_0[将视口设置为三维线框:SHADEMODE3]ID_YLGBHJS[压力管壁厚计算...]ID_EXTRUDE_0[通过拉伸现有二维对象来创建三维实体:EXTRUDE]ID_USERBUTTON_1[清理、核查、缩放并保存]ID_ROTATE3D_0[绕三维轴转动对象:ROTATE3D]ID_CALC1[实用计算器...]ID_3DPOLY_0[在三维空间中创建多段线:3DPOLY]ID_UNION_0[用并集创建组合面域或实体:UNION]ID_TBVIEWPOI_0[“视点”工具栏]ID_CALC[计算器...CTRL+SHIFT+ALT+Z]ID_GOURAUD_0[将视口设置为体着色:SHADEMODE]ID_WorkAffiliation[打开工作联系单...]////AutoCAD菜单文件结尾-C:Documentsan//其中前面加双斜杠的先不用管它

***MENUGROUP=wyp->这句是在CAD中的菜单组名***POP1这行为弹出菜单标识pop加上数字至于此部分的说明如下:////////////////////////////////////////////////////////////***MENUGROUP菜单组名***BUTTONSn定点设备按钮菜单***AUXn系统定点设备菜单***POPn下拉菜单和快捷菜单***TOOLBARS工具栏定义***IMAGE图像控件菜单***SCREEN屏幕菜单***TABLETn数字化仪菜单***HELPSTRINGS当亮显下拉菜单或快捷菜单项时,或者当光标位于工具栏按钮上时,显示状态栏中的文字***ACCELERATORS快捷键(或加速键)定义////////////////////////////////////////////////////////////////////////////////////////下面这句就开始定义菜单上的项目了ID_COMPUTE[富地2004(&C)]其中前面的ID_COMPUTE就是这个菜单项的唯一的标识,方括号内的就是菜单上显示的内容了,括号内的那个连字符加上一个字母C,它在菜单上会显示C下面带一个下划线,这个就是我们定义的热键,当屏幕显示此菜单时我们按Alt+C键时,就相当于我们用鼠标点击此菜单,在这行的后面我们什么也没加,是因为这是菜单的第一个项,因此不需要它做什么下一行的后面的这个^C^C-vbarunF:/编程/作品/CAD二次开发/二次开发/Vba计算/通信.dvb!n是我们点击此菜单项所执行的动作,前面的^C^C是相当于按了两次Esc键,主要是为了取消前一个正在运行的命令,下面的-vbarun是运行VBA程序的命令,再后面的的就是这个VBA宏文件的路径和名称了,如果将此宏文件的路径加到CAD支持文件的搜索路径内,就可以去掉前面的路径了。要注意的是在后面的行中的方括号内有->和<-符号,而且在右箭头的后面还没加代码,这是因为当CAD加载右箭头它解析为后面的项目为下一级的子菜单项。当出现左箭头时为结束子菜单项,返回上一级菜单下面的***ACCELERATORS定义快捷键的条目的前端的ID部分一定要和上边定义菜单部分的ID一样,这样快捷键才起作用下面的***HELPSTRINGS定义当鼠标移到菜单项上面时在CAD的左下角的提示栏内所显示的帮助信息,此部分的ID也要和菜单项的对应有人又要问了中间的工具条的部分怎么没有说呢?其实工具条我们可以在CAD里面做好后再用VBA将其导出到菜单文件,这样做起来也比较容易。不行了,太晚了得ZZ了等我下次再教大家怎样用VBA把已经做好的菜单和工具条导出到菜单文件中

做工具条第一步右击工具条,点自定义第二步选择菜单组,填工具条名出现工具条

第三步选择命令页,分类框内选择用户自定义,将右边的用户自定义按钮托到工具条上单击工具条上的用户自定义按钮,会自动转到按钮特性页面,选择图标、输入名称、说明和下面的宏保存

在VBA中可用以下命令将现有菜单保存到文件中(1).SaveAs"c:Test",acMenuFileSource用以下代码将菜单文件加载到CAD中"C:"SetmnuGroup=("菜单组名")MenuInMenuBar"Test(&T)",""(1).SaveAs"c:Test",acMenuFileSource这里括号内的数字为菜单组集合内的项目的索引,我的这里一共有5个索引是从0到4您也可以遍历这个集合,获得菜单组的名称进行指定的操作下面我将用一个完整的实例做一个简单的项目菜单文件的内容如下:***MENUGROUP=Test***POP1

ID_TEST[Test(&T)]ID_MButton[->鼠标中键控制]ID_MButtonPan[鼠标中键平移]^C^C_setvarmbuttonpan1ID_MButtonMenu[<-鼠标中键菜单]^C^C_setvarmbuttonpan0ID_filedia[->显示文件对话框]ID_filediaON[显示]^C^C_setvarfiledia1ID_filediaOFF[<-不显示]^C^C_setvarfiledia0ID_ZOOMFACTOR[鼠标辊抡缩放速度...]^C^C-vbarunc:/!_CALC[计算器...]^C^C-vbarunC:/!_CIRCLE[画圆...]^C^C-vbarunC:/!sID_MENUUPDATE[菜单更新]^C^C-vbarunC:/!menus***TOOLBARS***HELPSTRINGSID_CALC[打开计算器]ID_MButtonPan[当按下鼠标中键平移视口]ID_MButtonMenu[当按下鼠标中键弹出菜单]ID_filediaON[当对文件进行操作时打显示件对话框]ID_filediaOFF[当对文件进行操作时显示文件对话框]ID_ZOOMFACTOR[设置鼠标辊轮的缩放速度]ID_CIRCLE[画一个圆]ID_MENUUPDATE[从菜单文件更新此菜单]VBA源程序文件名为放在C盘根目录,里面添加一个模块,名为Module1,两个窗体分别名为frmCircle和frmMouseModule1里面的代码为下面内容:OptionExplicitDimMnuGroupAsAcadMenuGroupPublicEnumenuLineTypeltContinuous=0ltCenter=1ltDASHED=2ltPHANTOM=3EndEnumPublicSubcalc()Shell"",vbNormalFocusEndSubPublicSubSFSD()dSub

PublicSubCircles()dSubPublicSubUpdateMenu()EndSub'判断图层是否存在PublicFunctionLayerExist(ByValstrLayerNameAsString)=strLayerNameThenLayerExist=TrueExitForEndIfNextEndFunction'添加图层PublicFunctionAddLayers(ByValstrLayerNameAsString,LineTypeAsenuLineType,lColorAsACAD_COLOR,lineWeightAsAcLineWeight)AsAcadLayerDimobjLayerAsAcadLayerOnErrorGoToLineErrorSetobjLayer=(strLayerName)IfLineTypeExist(LineType)=tLineTypeString(LineType),""'添加线型pe=GetLineTypeString(LineType)=ight=lineWeightSetAddLayers=objLayerExitFunctionLineError:&Chr(13)&ption,16EndFunction'获得图层PublicFunctionGetLayer(ByValstrLayerNameAsString)=strLayerNameThenSetGetLayer=objLayerExitFor

EndIfNextEndFunction'判断线型是否存在PrivateFunctionLineTypeExist(ByValLineTypeNameAsenuLineType)AsBoo=GetLineTypeString(LineTypeName)ThenLineTypeExist=TrueExitForEndIfNextEndFunctionPrivateFunctionGetLineTypeString(ByValLineTypeAsenuLineType)AsStringSelectCaseLineTypeCaseIs=ltContinuousGetLineTypeString="Continuous"CaseIs=ltCenterGetLineTypeString="CENTER"CaseIs=ltDASHEDGetLineTypeString="DASHED"CaseIs=ltPHANTOMGetLineTypeString="PHANTOM"EndSelectEndFunctionPublicSubUpdateMenus()("Test")."c:"SetMnuGroup=("Test")MenuInMenuBar"Test(&T)",+1EndSubfrmCircle的窗体内容为

'窗体内的代码为:OptionExplicitDimdblPoints(2)AsDouble,dblRAsDoublePrivateSubcmdOK_Click()DimobjCircleAsAcadCircleDimobjLayerAsAcadLayer,objOldLayerAsAcadLayerDimdblStart(2)AsDouble,dblEnd(2)AsDouble,dblExtendAsDoubledblPoints(0)=Val()dblPoints(1)=Val()dblPoints(2)=Val()dblR=Val()dblExtend=Val()IfLayerExist("轮廓线层")=FalseThenSetobjLayer=AddLayers("轮廓线层",ltContinuous,acWhite,acLnWtByLwDefault)ElseSetobjLayer=GetLayer("轮廓线层")EndIfSetobjOldLayer=Layer=objLayer'保存原来的图层'添加轮廓线层'设置轮廓线层为当前层SetobjCircle=cle(dblPoints,Val())'画圆IfLayerExist("中心线层")=FalseThenSetobjLayer=AddLayers("中心线层",ltCenter,acRed,acLnWtByLwDefault)ElseSetobjLayer=GetLayer("中心线层")EndIf'添加中心线层

Layer=objLayer'设置中心线层为当前层dblStart(0)=dblPoints(0)-dblR-dblExtenddblStart(1)=dblPoints(1)dblStart(2)=dblPoints(2)dblEnd(0)=dblPoints(0)+dblR+dblExtenddblEnd(1)=dblPoints(1)dblEnd(2)=dblPoints(2)edblStart,dblEnddblStart(0)=dblPoints(0)dblStart(1)=dblPoints(1)+dblR+dblExtenddblStart(2)=dblPoints(2)dblEnd(0)=dblPoints(0)dblEnd(1)=dblPoints(1)-dblR-dblExtenddblEnd(2)=dblPoints(2)edblStart,Layer=objOldLayer'还原之前的层UnloadMeEndSub'在模型空间选择圆心座标点PrivateSubcmdSelect_Click()rPoint=nt(,"请选择点:")=varPoint(0)=varPoint(1)=varPoint(2)dSubPrivateSubTxtExtend_Change()EndSub'frmMouse的窗体内容为

'窗体内的代码为:PrivateSubcmdOK_Click()DimsysVarNameAsString,sysVarDataAsVariantsysVarName="ZOOMFACTOR"sysVarData=Int(Val())iablesysVarName,sysVarDataUnloadMeEndSub好了,我的程序部分已经做完了,下面要把菜单加入CAD了第一步打开CAD输入命令menuload回车第二步点击浏览找到我们之前做好的放在C盘根目录的文件,并点加载第三步点菜单栏选项卡,将我们的菜单加到想要的位置

OK其实加载菜单也不用象上边图示的这么麻烦,完全可以用一个CAD文件,在里面的双击事件里加上上面提到的更新菜单的代码方法如下第一步:新建一文件,打开VBA管理器

然后新建选中后点击嵌入,然后删除那个全局的,打开VisuleBasic编辑器,写入代码然后保存CAD文件为

以后打开文件,直接双击就可以了,尤其是对公司内部局域网的边用边开发的那种别人不知道怎么做的情况下,只告诉他们打开双击就可以了