(精品论文)冷冲压模具标准件库

毕业设计（论文） 第一章 传统冲模标准件的绘制与采用标准件库绘制的比较模具是典型的技术密集型产品，其结构复杂，设计、制造难度高，周期长。为了表达模具结构，设计人员必须花费大量时间来绘制模架、顶杆、滑块等结构相对稳定的零部件。据统计，平均每套模具中有40-60%的零部件为标准件或具有一定的固定结构；因此，抽取零部件的标准件结构，选定尺寸系列优先值，建立标准模架和标准件库，对于快速绘制模具装配图及拆分零件图，缩短设计周期具有重要的意义。传统的实现手段是在CAD中建立图块，这种方法虽然简单，但是工作量特别大，因为每种标准件因其参数的变化又可以画出很多个零件，如果按传统方法建图块的话，显然需要很多时间，而且所建图块的储存又要占用很多空间。这与减少计算机资源浪费，提高工作效率是矛盾的。因此我们必须寻找一种更好的方法来解决这个问题，即通过参数化编程，对CAD进行二次开发，建立冲模标准件库。这种方法只需对每种标准件编程，根据其选择的不同参数，计算机会自动生成相应的零件图块，而且在生成的过程中还可选择其放大或缩小的系数与旋转的角度。可见与传统方法比较，确实可以提高设计者的工作效率，而且更人性化，更符合当前模具设计的需要。 第2章 冷冲压模具标准件库产生的背景、意义及实现方法冲模标准件库一般包括国家标准中规定的标准件和企业为了设计、制造方便而自己定义的标准件（也就是所谓的厂标）。由于冷冲压的许多突出的优点，在机械制造、电子电器等各行各业中，都得到了广泛的应用，但冲压加工中所用的模具结构一般比较复杂，设计周期长、成本高，单件、小批量生产采用冲压工艺受到了一定的限制，不能适应当前社会的需求。另外，在AutoCAD中绘制模具装配图是一项繁琐的工作，由于冷冲压模具零部件众多且重复率较高，故绘图时存在许多重复性的工作，像模具的一些标准件，如模柄、模具卸料螺钉等绘图非常费事。为了提高绘图效率，开发冷冲压模具标准件库是必要的。同时由于计算机以运算速度快、存储量大、重复劳动耐力强、精确度高等方面见长，而人却以学习、分析、判断、决策等能力为优，因此在冷冲压模具标准件库过程中，人机特性的互补关系得到了最好的体现，同时也反映“计算机辅助”这一概念的真正含义所在。人机特性的良好发挥，又赋予冷冲压模具CAD无限的生命力。设计速度的大幅度提高，使模具设计与制造的周期缩短；同时使设计人员从繁重的绘图工作中解脱出来，有更多的时间和精力从事创新工作。这也恰好满足了目前用户提出的“短交货期” 、“高精度” 、“低成本”的迫切要求。基于以上这些，通过采用VBA对AutoCAD2008进行二次开发，使用ADO的方法来存取Access2003数据库，实现零件库的建立。在绘图过程中可通过在菜单中点选再在其弹出的面板中输入主要参数的方式选用零件，形象直观，大大简化设计绘图，减少工作量，提高工作效率，从而满足生产的需要。 第3章 冲压模具标准件库的组成与实现3.1 编程思路在AutoCAD 2008环境下，实现参数化编程，关键是将零件按一定的标准分类（本课题用图2的分类），再将零件的各个参数存在特定的数据库中（本课题采用Access 2003）,在使用时，通过程序的检索和排错，然后在AutoCAD 2008环境下，按照已给定的参数将模具标准件按设计者的要求绘在指定的位置。为了设计者的使用方便，采用对话框的编辑框来输入参数，同时在对话框中的预览框里用wmf格式的图形显示设计者所选用的标准件的形状，以防设计者选择错误。其程序框图如图1。 图（1）3.2 菜单的规划常用软件中菜单的结构一般为树状结构，即目录下包含有主菜单，主菜单下又包含有子菜单。冷冲压模具的零部件种类较多，其分类见图3。可根据图3的分类设置主菜单及其子菜单。图2是已建立完成的菜单的一部分。每一个人的工作习惯和喜好会有所不同，所以规划菜单时应将自己认为重要和常用的零部件放在前面，也可以将菜单依其功能或某个标准划分为几大主菜单，然后在细分一些子菜单。到此为止，规划的菜单仅是一个停留在纸上的蓝图，尚须制作图库、编写程序，方能实现其真正的功能。图（2）3.3 预览用标准件图库的建立建立专用的文件夹，与规划的菜单名称一一对应，以便于识别，将搜集整理的零部件图形资料在AutoCAD中以1：1的比例绘出，并以参数标注，绘制完一个图形后输入“ZOOM”命令，然后输入选项“E”将图形放大至全屏幕，这样做的目的是在将来预览显示时图形清晰并可充满整个预览框，然后在“文件”菜单下选择“输出”命令，选择其保存路径和其文件名称，再按要求选择刚才所画的图形，然后按ENTER键至该命令结束。该命令可清理掉一些不必要的外部引用及其关联，可大大减少文件所占容量，到此已将文件保存到相应的文件夹中，其所取的文件名应易于互相区分，能够体现出其含义。 图（3）3.4 建立Access零件数据库在Access2003中建立每种标准件的参数表及其属性表，并保存在相应的文件夹下面。属性表字段有型号、名称、材质、公差、热处理、产品等级及技术条件等，其中“GB/JB”作为检索主键。如图4。 图（4）3.5 编写程序并连接数据库3.5.1 VBA概论由于本课题采用VBA编程，故对VBA作一简介如下：所谓VBA就是Visual Basic for Application的简称。由于它是一个引入了对象的程序设计环境，为用户提供类似Visual Basic(VB)语言所拥有的功能，所以后续潜力无穷。一般说来，VBA和VB的主要差异类似AutoLISP与LISP间的差异，就是：VBA可以执行并存取AutoCAD环境的所有资源。此外，VBA可以整合其他具有VBA能力的应用程序。这使的AutoCAD可以成为其他应用程序（如Word或Excel）的Automation控制器。从运作上来看，VBA通过AutoCAD ActiveX Automation接口将信息传送给AutoCAD。而AutoCAD VBA也允许VBA环境与AutoCAD同时执行并通过ActiveX Automation接口提供AutoCAD的程序。如此，AutoCAD、ActiveX Automation与VBA的结合方式，提供了功能极强大的接口，不仅可以操作AutoCAD的内部对象件，更可以在其他的应用程序之间传送或接收数据。3.5.2 用VBA编程并连接数据库由于本课题采用的是Access建的数据库，故ODBC的设定为：driver=Microsoft Access Driver(*.mdb)dbp=Full Database Path本课题将使用ADO的方法来存取数据库，Microsoft ActiveX DataObjects(ADO)能够编写出可通过OLE DB对在数据库服务器中的数据进行存取和操作的应用程序。其主要优点是：易于使用、高速、低内存支出与占用磁盘空间较少。ADO支持适用于客户端/服务器端与Web端等应用程序的主要功能。ADO是一个对象模型，它结合了OLE DB易于使用的的特性以及在诸如RemoteData Objects(RDO)和Data Access Objects(DAO)的模型中容易找到的通用特性。更重要的是：ADO包含了所有可以被OLE DB标准接口描述的数据类型。换句话说，ADO对象模型具有可扩展性，它不需要对自己的组件做任何工作，只要通过一般的ADO程序设计接口，就可以可视化地处理所有的事，即使那些记录信息的格式是从来没有见过的。另外，ADO在实际运行中也得到了很高的评价，如内存覆盖、线程安全、分散式事务支持，还可以执行Web的远程数据存取（例如ADO同时具有远程数据服务（RDS）功能，通过RDS，可以在一次往返过程中执行将数据从服务器移动到用户端应用程序或Web网页，在客户端对数据进行处理然后将更新结果返回服务器的操作）。作为Microsoft UDA策略的一部分，ADO还试图成为跨平台数据存取的标准模型。同时ADO也集中了RDO和DAO所有最好的特性，并将它们重新组织在一个同样可以提供对事件充分支持，但略微有点不同的对象模型中。编程将主要分四个模块，分别是main模块、block模块、insert模块和create模块。其中main模块的主要功能是连接或释放数据库，调用和关闭相关窗体以及调用其他模块等。block模块的主要功能是定义主视图块和侧视图块。insert模块的主要功能是插入所画的标准件视图图块。create模块的功能是标准件的绘制程序。窗体主要有两个，第一个窗体是让用户选择标准件类型并伴随着相关标准件的图形预览。第二个窗体是提示用户输入所选标准件的型号、名称、材质、公差、热处理、产品等级及技术条件等属性，输入主要可变参数及选择所需视图，同时也伴随着图形预览。当所输入的不是数字或者输入的数字不在允许的范围内时，第二个窗体会弹出警告提示。两个主要窗体如图5。3.6 编写菜单程序3.6.1 AutoCAD菜单的运作 AutoCAD系统的基础菜单文件放在AutoCAD安装目录下的SUPPORT子目录中，共有五个文件。无论是AutoCAD系统的基础菜单，还是附加（局部）菜单或是用户自已定制的菜单，都是由.mnu/.mnc/.mns/.mnr/.mnl这五个文件组成。这五个文件组成了一个菜单的整体，但也并不是每一个菜单都包括全部的这五个文件。五个文件在菜单中起着各自的作用，但其作用是有主次之分的，其生成过程有也主从之分。要使用好菜单，必须明白这五个文件相互之间的关系和在菜单的调用过程中各自所起的作用。.mnu是模板菜单文件，除了.mnl文件外，其余三个文件最初都源出自于它。AutoCAD调用时自动对它进行编译，产生对应的.mnc和.mnr文件以及.mns文件。.mnc是.mnu文件编译后的版本，实际上.mnc文件是AutoCAD真正直接执行的菜单文件。.mnr也是在.mnu文件编译时产生，它存放着菜单所使用的位图之类的菜单资源。最初的.mns文件也是.mnu文件被编译时由AutoCAD自动产生的，它的基本内容和.mnu文件类似，只是少了有关的说明和注释行。在.mnu文件被编译时，.mns文件和.mnc文件的菜单内容是一致的，但如果在AutoCAD的操作中，用户对菜单的作了更改，这些改动都记录在.mns文件中，所以.mns文件对应的是AutoCAD系统中当前菜单的内容。.mnl文件在内容上相对独立一些，它包含由菜单所使用的AutoLISP表达式，如各种命令简化指令的定义，还有层排序、指定层这样的LISP程序。当加载一个菜单文件时，如果系统中存在与菜单文件同名的.mnl文件，则这个.mnl文件也会被加载。3.6.2 冷冲模标准件库菜单的制作要实现模具零部件菜单的建立，必须在AutoCAD的菜单文件ACAD.MNU中加入一些程序，ACAD.MNU文件包含了AutoCAD菜单的全部功能选项，所谓中文的AutoCAD也就是将该文件中的一些菜单名改为中文而已。该文件位于AutoCAD文件夹的SUPPORT目录下，在记事本中打开该文件，将该文件中的POP11HELP（POP后的数字表示下拉菜单的序号）菜单改为POP12HELP，然后在POP10WINDOW与POP12HELP之间插入自己的POP11，在其下输入程序即可实现编制菜单的目的。以下以导柱为例说明：ID_Guide_pillars 导柱(&Z) CC_(commandvbaloadGUIDE_PILLARS);(command-vbarunguide_pillarsType);这个语法的意思就是说：先使用VBALOAD指令来加载这个VBA程序，最后再使用-VBARUN指令（即执行VBARUN指令的行功能）来执行这个VBA程序。其中，GUIDE_PILLAR为VBA程序文件名称；而guide_pillarsType则为可激发该程序的模块名称。 图（5）3.7 菜单的加载及调试3.7.1 何时用menu,何时用menuload加载菜单？ AutoCAD加载菜单有两个命令：menu和menuload。何时使用menu，何时使用nenuload？首先必须明白AutoCAD菜单是有等级之分的，分为基础菜单和局部（或称附加）菜单。 顾名思义，基础菜单是AutoCAD使用是菜单的基础，在AutoCAD中同时只能使用一个菜单文件作为基础菜单，acad.mnu是安装时缺省的基础菜单。menu命令专用于更换或重新加载一个基础菜单，AutoCAD启动时缺省的基础菜单是上一次通过menu命令调入的菜单。 局部菜单和基础菜单在文件体系上没有区别。在基础菜单之上,可以在下拉菜单中附加上额外的菜单项，这种可附加的菜单就可称作为局部菜单。局部菜单使用menuload命令加载。Menuload命令从下拉菜单中也可以调用，方法是：“Tools menu(工具)”“Customize Menus(定制菜单)”。用menuload可以同时加载多个菜单文件。 对于现有的下拉菜单项，都可以在进入“Menu Customization(菜单定制)”界面后，选“Menu Bar(菜单条)”来进行“Remove(移除)”或“Insert(插入)”。 Menuload加载的局部菜单可以用menuunload命令将其卸载。而用menu命令加载的基础菜单只能由下一个menu命令加载来替换。 3.7.2 如何使对于菜单的改动得以固定和保存？AutoCAD加载菜单缺省的过程是这样的：菜单命令发出后，AutoCAD首先加载指定菜单名的.mnc文件；如果.mnc不存在，则寻找同名的.mns文件，将其编译成.mnc文件并完成加载；如果同名的.mnc和.mns文件都不存在，则寻找.mnu文件并完成编译和加载。根据菜单加载的过程可以采取如下措施： 1.如果对菜单模板文件.mnu进行了修改，并要让改动起作用，就必须在启动AutoCAD系统前将.mns和.mnc文件删除，或是重新加载.mnu模板菜单文件。加载.mnu文件应注意的是：在调入菜单的对话框中将文件类型改为“Menu template(*.mnu)”而不是缺省的“Menu files(*.mnc;*.mns)”，这样才能选择.mnu文件。 2.如果在AutoCAD中，用AutoCAD的功能对菜单进行了修改，这些变化自动记录在.mns文件中，为了使修改得以固定，在删除.mns文件之前，应将修改的内容移到.mnu文件的相应部位中，并将.mnu文件备份下来。如果这些改动是在基础菜单acad.mnu中，则应在AutoCAD重新安装后，用改动过的acad.mnu去覆盖AutoCAD原始的acad.mnu，并删除掉已存在的acad.mnc和acad.mns文件。 3.如果在AutoCAD启动后对菜单进行了修改，想要取消这些修改，恢复启动前的菜单状态，可以用menu命令，调入acad.mnu菜单模板文件3.7.3 新菜单的调试运行在AutoCAD状态下输入命令MENU，可为AutoCAD装入刚完成的菜单文件，完成后即可见到如上面的模具零件库菜单项，点选其下的选项即可选用所需的零部件。第4章 实例源程序说明以导柱各模块和窗体源程序为例说明冷冲压模具标准件库的程序编制过程4.1 main模块源程序Public conn As New ADODB.Connection 定义新连接Public cmd As New ADODB.Command 定义指令Public rs As New ADODB.Recordset, rs2 As New ADODB.Recordset 定义两个记录集Public gb As String gb变量来储存型号Public exitf1, exitf2 As Boolean 用来判断是否要退出程序用来判断是否要主视图还是侧视图Public mainview As Boolean, sideview As Boolean 定义主视图块和侧视图块Public mainblock As AcadBlock, sideblock As AcadBlock定义主视图块名称和侧视图块名称Public mainblockname As String, sideblockname As String Public blength As Double 将导柱长度存与blength变量中Public mn As String 储存类似“M？”的导柱类型Public Sub guide_pillarsType() 设定导柱的Access数据库类型及文件路径 driver = Microsoft Access Driver (*.mdb) dbq = d:/毕业设计/导向零件/导柱/guide_pillars.mdb 连接至数据库 conn.Open driver= & driver & ;dbq= & dbq 设定SQL指令 Set cmd.ActiveConnection = conn cmd.CommandText = SELECT * from type operate in table type 经过已定义的SQL来获取记录组（列表） rs.CursorLocation = adUseClient rs.Open cmd, , adOpenStatic, adLockBatchOptimistic 调用选择型号窗体 UserForm1.Show If exitf1 Then 如果单击“取消”按钮就跳出程序 rs.Close 关闭记录组以放释内存 conn.Close Exit Sub End If 调用选择详细规格窗体 UserForm2.Show If exitf2 Then 如果单击“取消”按钮就跳出程序 rs.Close 关闭记录组以放释内存 conn.Close Exit Sub End If 根据选择来建立导柱图块 Block.DefineBlock rs.Close 关闭数据库的记录组和连接 conn.Close ThisDrawing.Regen acActiveViewport 重新产生图形End Sub4.2 insert模块源程序Public Sub Insert() 将图块插入到模型空间中 Dim blkRefObj As AcadBlockReference Dim insertPt As Variant Dim xscale As Double, yscale As Double Dim rotangle As Double Const pi = 3.1415926536 If mainview = True Then insertPt = ThisDrawing.Utility.GetPoint(, 主视图的插入点:) 预设X与Y方向的缩放比例系数与旋转角度 xscale = 1: yscale = 1: rotangle = 0 On Error Resume Next 如果发生错误就使用默认值 xscale = ThisDrawing.Utility.GetReal(X 轴缩放比例系数:) yscale = ThisDrawing.Utility.GetReal(Y 轴缩放比例系数:) rotangle = ThisDrawing.Utility.GetReal(旋转角度:) / 180 * pi Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPt, mainblockname, xscale, yscale, 1#, rotangle) End If If sideview = True Then insertPt = ThisDrawing.Utility.GetPoint(, 侧视图的插入点:) xscale = 1: yscale = 1: rotangle = 0 On Error Resume Next xscale = ThisDrawing.Utility.GetReal(X 轴缩放比例系数:) yscale = ThisDrawing.Utility.GetReal(Y 轴缩放比例系数:) rotangle = ThisDrawing.Utility.GetReal(旋转角度:) / 180 * pi Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPt, sideblockname, xscale, yscale, 1#, rotangle)End IfEnd Sub4.3 block模块源程序Public Sub DefineBlock() 定义导柱图块 Dim insertPt(0 To 2) As Double If mainview = True Then 定义主视图图块名称 mainblockname = bbm & rs(0) & mn End If If sideview = True Then 定义侧视图图块名称 sideblockname = bbs & rs(0) & mn End If insertPt(0) = 0: insertPt(1) = 0: insertPt(2) = 0 建立导柱图块 If (mainblockname ) Then Set mainblock = ThisDrawing.Blocks.Add(insertPt, mainblockname) End If If (sideblockname ) Then Set sideblock = ThisDrawing.Blocks.Add(insertPt, sideblockname) End If Select Case rs(0) 建立因选择不同的导柱而执行不同的导柱图块画出 Case JB76451 CreateGuide_pillars.JB76451 Case JB76452 CreateGuide_pillars.JB76452 End SelectEnd Sub4.4 create 模块源程序Public Sub JB76451() Dim util As Object Set util = ThisDrawing.Utility 定义一个utility来建立点 Dim mblockf, sblockf As Boolean 定义一个flag来判别图块是否存在 mblockf = False sblockf = False 如果图块名称存在就跳过建立图块的程序 Dim iblock As Integer iblock = ThisDrawing.Blocks.Count Do While (iblock 0) If ThisDrawing.Blocks.Item(iblock - 1).name = bbmjb76451 & mn Then blockf = True End If If ThisDrawing.Blocks.Item(iblock - 1).name = bbsjb76451 & mn Then blockf = True End If iblock = iblock - 1 Loop 定义导柱的设计参数Dim d, d1, d2, l1, r, L As DoubleL = blength get other parameters from database, some need simple change d = rs2(d) d1 = rs2(d1) d2 = rs2(d2) l1 = rs2(l1) r = rs2(r) 画出主视图的导柱图块 If (mainview = True) And (mblockf = False) Then 定义一些必要的点变体 Dim bp, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15 As Variant 定义画图所需的线对象 Dim ln1, ln2, ln3, ln4, ln5, ln6, ln7, ln8, ln9 As AcadLine 定义画图所需的弧对象 Dim a1 As AcadArc 定义一些画弧所需临时变体 Dim arc1_angs, arc1_ange As Double 定义一些画点所需临时变体 Dim bpx, bpy, p1x, p1y, p2x, p2y, p3x, p3y, p4x, p4y, p5x, p5y, p6x, p6y As Double Dim p7x, p7y, p8x, p8y, p9x, p9y, p10x, p10y, p11x, p11y, p12x, p12y, p13x, p13y, p14x, p14y, p15x, p15y As Double 计算需要的坐标点 bpx = 0#: bpy = 0# p1x = bpx: p1y = bpy + d2 / 2 p2x = bpx + 5: p2y = p1y p3x = p2x: p3y = d / 2 - 0.5 p4x = p3x + 2: p4y = p3y p5x = p4x: p5y = d / 2 p6x = bpx + L - r: p6y = p5y p7x = p6x: p7y = p6y - r p8x = p7x + r: p8y = p7y p9x = p8x: p9y = bpy p10x = bpx + 7: p10y = bpy p11x = bpx + 5: p11y = bpy p12x = bpx + l1: p12y = p5y p13x = p12x: p13y = bpy p14x = bpx - 2: p14y = bpy p15x = p9x + 2: p15y = bpy 建立点 util.CreateTypedArray bp, vbDouble, bpx, bpy, 0 util.CreateTypedArray p1, vbDouble, p1x, p1y, 0 util.CreateTypedArray p2, vbDouble, p2x, p2y, 0 util.CreateTypedArray p3, vbDouble, p3x, p3y, 0 util.CreateTypedArray p4, vbDouble, p4x, p4y, 0 util.CreateTypedArray p5, vbDouble, p5x, p5y, 0 util.CreateTypedArray p6, vbDouble, p6x, p6y, 0 util.CreateTypedArray p7, vbDouble, p7x, p7y, 0 util.CreateTypedArray p8, vbDouble, p8x, p8y, 0 util.CreateTypedArray p9, vbDouble, p9x, p9y, 0 util.CreateTypedArray p10, vbDouble, p10x, p10y, 0 util.CreateTypedArray p11, vbDouble, p11x, p11y, 0 util.CreateTypedArray p12, vbDouble, p12x, p12y, 0 util.CreateTypedArray p13, vbDouble, p13x, p13y, 0 util.CreateTypedArray p14, vbDouble, p14x, p14y, 0 util.CreateTypedArray p15, vbDouble, p15x, p15y, 0 画出导柱中的线段 Set ln1 = mainblock.AddLine(bp, p1) Set ln2 = mainblock.AddLine(p1, p2) Set ln3 = mainblock.AddLine(p2, p11) Set ln4 = mainblock.AddLine(p3, p4) Set ln5 = mainblock.AddLine(p5, p10) Set ln6 = mainblock.AddLine(p12, p13) Set ln7 = mainblock.AddLine(p5, p6) Set ln8 = mainblock.AddLine(p8, p9) arc1_angs = ThisDrawing.Utility.AngleFromXAxis(p7, p8) 计算弧的起始角 arc1_ange = ThisDrawing.Utility.AngleFromXAxis(p7, p6) 计算弧的终止角 Set a1 = mainblock.AddArc(p7, r, arc1_angs, arc1_ange) 画出弧 镜像半个导柱 Dim acadent As AcadEntity 定义一个图素 For Each acadent In mainblock 逐一镜像导柱的每一个像素 acadent.Mirror bp, p9 Next acadent Set ln9 = mainblock.AddLine(p14, p15) 画出一条中心线 ln9.Color = acMagenta 改变中心线的颜色End If 画出导柱的侧视图块 If (sideview = True) And (sblockf = False) Then Dim center, pt1, pt2, pt3, pt4 As Variant 定义需要的点 Dim line1, line2 As AcadLine 定义两条线 Dim circ1 As AcadCircle 定义一圆 定义一些变体来建立点 Dim centerx, centery, pt1x, pt1y, pt2x, pt2y, pt3x, pt3y, pt4x, pt4y As Double 计算出所需的坐标点 centerx = 0#: centery = 0# pt1x = centerx - d2 / 2 - 2: pt1y = centery pt2x = centerx + d2 / 2 + 2: pt2y = centery pt3x = centerx: pt3y = centery + d2 / 2 + 2 pt4x = centerx: pt4y = centery - d2 / 2 - 2 建立点 util.CreateTypedArray center, vbDouble, centerx, centery, 0 util.CreateTypedArray pt1, vbDouble, pt1x, pt1y, 0 util.CreateTypedArray pt2, vbDouble, pt2x, pt2y, 0 util.CreateTypedArray pt3, vbDouble, pt3x, pt3y, 0 util.CreateTypedArray pt4, vbDouble, pt4x, pt4y, 0 画出一些线，并设定其中之一的颜色为magenta Set line1 = sideblock.AddLine(pt1, pt2) Set line2 = sideblock.AddLine(pt3, pt4) line1.Color = acMagenta line2.Color = acMagenta 画出圆 Set circ1 = sideblock.AddCircle(center, d2 / 2) End If 产生图形 ThisDrawing.Regen acActiveViewport InsertGuide_pillars.Insert 插入导柱图块 End SubPublic Sub JB76452() Dim util As Object Set util = ThisDrawing.Utility Dim mblockf, sblockf As Boolean mblockf = False sblockf = False Dim iblock As Integer iblock = ThisDrawing.Blocks.Count Do While (iblock 0) If ThisDrawing.Blocks.Item(iblock - 1).name = bbmjb76452 & mn Then blockf = True End If If ThisDrawing.Blocks.Item(iblock - 1).name = bbsjb76452 & mn Then blockf = True End If iblock = iblock - 1 Loop Dim d, d1, d2, l1, r, L As Double L = blength get other parameters from database, some need simple change d = rs2(d) d1 = rs2(d1) d2 = rs2(d2) l1 = rs2(l1) r = rs2(r) If (mainview = True) And (mblockf = False) Then Dim bp, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, cenPt1, cenPt2 As Variant Dim ln1, ln2, ln3, ln4, ln5, ln6, ln7, ln8, ln9, ln10 As AcadLine Dim a1, a2, a3 As AcadArc Dim arc1_angs, arc1_ange, arc2_angs, arc2_ange, arc3_angs, arc3_ange As Double Dim bpx, bpy, p1x, p1y, p2x, p2y, p3x, p3y, p4x, p4y, p5x, p5y, p6x, p6y, p7x, p7y, p8x, p8y, p9x, p9y As Double Dim p10x, p10y, p11x, p11y, p12