CAD二次开发报告示例(共7页)

精选优质文档-倾情为你奉上城市轨道交通线路设计平曲线绘制一、程序要求1、新建数据库，名称为“基础数据.mdb”。2、建立数据表：plane_CureveData(平面曲线信息表)。字段名称和类型如表1所示。3、同时，新建一个窗体，窗体中放置MsFLexGrid表格控件一个，导入按钮实现将文本文件内容导入到MsFLexGrid表格控件；增加、修改、删除数据的相关编辑；保存实现表格数据保存到数据库（基础数据.mdb）中功能，界面如图1。 4、根据曲线信息，计算五大桩里程，新建立图层“平曲线图”，并在图层“平曲线图”中绘制平曲线图,并标注出曲线五要素，字体任意设定为中文字体，颜色任意。同时设定线宽为1、线颜色任意。表1 平面曲线信息表字段名称和类型字段名称 数据类型交点编号 dbText交点桩号 dbSingle曲线类型 dbText曲线转向 dbText曲线半径 dbSingle曲线转角 dbSingle起端缓和曲线长度 dbSingle终端缓和曲线长度 dbSingle二、主要过程1、新建三个窗体，分别为新建项目、打开项目和平面曲线数据。“新建项目”窗体实现新建名为“基础数据.xxd”的项目文件和“基础数据.mdb”的数据库文件（内含数据表plane_CureveData，表内无数据）；“打开项目”窗体实现打开已有项目并在AutoCAD中自动绘制平曲线图；“平面曲线数据”窗体包含一个FlexGrid表格控件，实现导入包含平面曲线数据的文本文件（平面曲线.txt）并且能够对表格内的数据进行增加、修改、删除，最终保存入已打开项目对应的数据库文件中。2、在程序中，按照上述要求编写相关代码。节选部分重要代码如下所示：（1）新建数据库代码图1 平面曲线数据窗体Public Sub CreateDatabase() '创建数据库Dim m_WorkSpace As Workspace Set m_WorkSpace = DBEngine.Workspaces(0) Dim newdb As Database '定义数据库变量 m_DatabaseName = m_ProjectPath + "基础数据.mdb" '设定新建数据库位置 Set newdb = m_WorkSpace.CreateDatabase(m_DatabaseName, dbLangChineseSimplified) Dim newtbl As TableDef '创建表 plane_CureveData Set newtbl = newdb.CreateTableDef("plane_CureveData") '平面曲线信息表 Set m_Field(1) = newtbl.CreateField("交点编号", dbText) Set m_Field(2) = newtbl.CreateField("交点桩号", dbSingle) Set m_Field(3) = newtbl.CreateField("曲线类型", dbText) Set m_Field(4) = newtbl.CreateField("曲线转向", dbText) Set m_Field(5) = newtbl.CreateField("曲线半径", dbSingle) Set m_Field(6) = newtbl.CreateField("曲线转角", dbSingle) Set m_Field(7) = newtbl.CreateField("起端缓和曲线长度", dbSingle) Set m_Field(8) = newtbl.CreateField("终端缓和曲线长度", dbSingle) Call CreateTable(newdb, newtbl, 8) '生成表 MsgBox "项目创建成功", vbInformation, "新建项目" newdb.Close '关闭数据库及其中的表 Set newdb = Nothing '删除数据库对象实例End Sub（2）创建菜单示例创建项目管理菜单Public Function CreateProjectManageMenu() On Error Resume Next Dim mnuGroup As AcadMenuGroup Dim mnuMain As AcadPopupMenu Dim menuNames As String Dim menuCollection As AcadPopupMenus Dim menu As AcadPopupMenu Set mnuGroup=ThisDrawing.Application.MenuGroups.Item(0) Set mnuMain = mnuGroup.Menus.Add("项目管理(&P)") Call BuildSubMenu(mnuMain, "新建设计项目(&N)", "mcoNewProject") '分隔符End Function（3）绘制平曲线代码'绘制平面线型Sub DrawPMLine() On Error Resume Next Dim plineObj As AcadLWPolyline Dim points(0 To 11) As Double Dim textString As String Dim QZ As Double '曲中桩号 Dim ZH As Double '直缓桩号 Dim HY As Double '缓圆桩号 Dim YH As Double '园缓桩号 Dim HZ As Double '缓直桩号 Dim a As Double '转角 Dim Ls0 As Double '起端缓和曲线长 Dim Le0 As Double '终端缓和曲线长 Dim R As Double '曲线半径 Dim L As Double '曲线长 Dim T As Double '切线长 Dim P As Double Dim m As Double Dim PI As Double Dim Text_a As String Dim a_Du As Double Dim a_Fen As Double Dim a_Miao As Double Call SetFontName("楷体_GB2312") PI = 3. If Len(m_DatabaseName) <= 0 Then '表示还没有打开数据库连接 Exit Sub End If ' 创建名为"平曲线图"的新图层 Dim LayerObj As AcadLayer Set LayerObj = ThisDrawing.Layers.Add("平曲线图") LayerObj.color = acCyan ' 指定"平曲线图"图层的颜色为青色 Dim i As Long Dim mSQL As String '打开数据库连接 Set Con = New ADODB.Connection mSQL = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" + m_DatabaseName + "" Con.Open mSQL '设置记录集 Set mrs = New ADODB.Recordset Set mrs.ActiveConnection = Con '设置记录当前接连 mrs.CursorLocation = adUseClient mSQL = "select * from plane_CureveData ORDER BY 交点桩号 ASC" mrs.Open mSQL, Con, adOpenKeyset, adLockOptimistic '打开记录集 Dim m_Totals As Integer m_Totals = 0 Do While Not mrs.EOF '将表格所有数据写入数据库表中 m_Totals = m_Totals + 1 If (m_Totals = 1) Then a = mrs.Fields(5) Ls0 = mrs.Fields(6) Le0 = mrs.Fields(7) R = mrs.Fields(4) P = Ls0 * Ls0 / (24 * R) m = Ls0 / 2 T = (R + P) * Tan(a * PI / 360) + m L = PI * a * R / 180 + Ls0 a_Du = Fix(a) a_Fen = Fix(a - a_Du) * 60) a_Miao = Round(a - a_Du) * 60 - a_Fen) * 60, 2) Text_a = Str(a_Du) & "°" & Str(a_Fen) & "" & Str(a_Miao) & "" textString = "R=" & Str(R) & " " & "=" & Text_a & " " & vbCrLf & "T=" & Str(Round(T, 2) & " " & "lo=" & Str(Ls0) + " " & "L=" & Str(Round(L, 2) QZ = mrs.Fields(1) ZH = QZ - T HY = ZH + Ls0 HZ = QZ + T YH = HZ - Le0 points(0) = 0: points(1) = 0 points(2) = ZH: points(3) = points(1) points(4) = HY If (mrs.Fields(3) = "左") Then points(5) = -50 Call DrawText(ZH + 30, points(1) + 80, textString, 150, 0, acAlignmentMiddleLeft) Else If (mrs.Fields(3) = "右") Then points(5) = 50 Call DrawText(ZH + 30, points(1) - 30, textString, 150, 0, acAlignmentMiddleLeft) End If End If points(6) = QZ: points(7) = points(5) points(8) = YH: points(9) = points(5) points(10) = HZ: points(11) = points(1) m_X = points(10): m_Y = points(11) Set plineObj=ThisDrawing.ModelSpace. _AddLightWeightPolyline(points) plineObj.Layer = "平曲线图" plineObj.ConstantWidth = 1 '多段线全局宽度 m_Totals = m_Totals + 1 mrs.MoveNext End If（以上是第一段曲线绘制的代码）plineObj.ConstantWidth = 1 '多段线全局宽度' ' 指定多段线到"地面线"图层上 plineObj.Layer = "平曲线图" plineObj.Update ZoomAllEnd Sub3、效果展示图2 第一段平曲线图专心-专注-专业