好文档就是一把金锄头!
欢迎来到金锄头文库![会员中心]
电子文档交易市场
安卓APP | ios版本
电子文档交易市场
安卓APP | ios版本

AUTOCAD+VBA+生成道路测量中的纵横断面数据表(版2).doc

14页
  • 卖家[上传人]:大米
  • 文档编号:380308171
  • 上传时间:2023-10-26
  • 文档格式:DOC
  • 文档大小:369KB
  • / 14 举报 版权申诉 马上下载
  • 文本预览
  • 下载提示
  • 常见问题
    • AUTOCAD VBA 辅助制作道路测量中的纵横断面数据表AUTOCAD VBA 辅助制作道路测量中的纵横断面数据表中国有色金属工业长沙勘察设计研究院珠海分院 苏伟AUTOCAD集成的VBA为AUTOCAD二次开发提了一个便捷途径,通过VBA可实现AUTOCAD与其它应用软件进行通信,实现数据交换,本文介绍如何利用AUTOCAD VBA编程建立与Excel通信(本文中所使用的为AUTOCAD2004及EXCEL2007),方便快捷的生成道路纵横断面数据表关键词:AUTOCAD VBA与EXCEL通信 纵横断面数据表一. 前言 在道路测量中,为满足设计方要求,不但需要AUTOCAD电子地形图,还需要能够反映道路设计线上地表起伏状况的电子纵横断面数据表,纵横面数据表为反映设计中线上地表起伏状况,横面数据表为反映与设计线垂直的截面地表起伏状况纵横断面数据表为能够批量形成纵横断面图,需要有固定格式,一般格式:如图1 图2 所示:在没有辅助软件情况下,利用现有电子地形图制作纵横数据表,需要进行大量繁琐的工作,即劳神,又易出错,本文介绍利用AUTOCAD VBA编程实现只在AUTOCAD中操作,完成在EXCEL中形成纵横断面数据表。

      图1图2二. 工作机理1.VBA简介:VISUAL BASIC FOR APPLICATION (VBA)是MICROSEFT面向最终用户应用软件编程语言,基于AUTOCAD的VBA应用程序是高级程序语言的计算功能与AUTOCAD的绘图功能的结合,通过AUTOCAD VBA编程,能够使AUTOCAD数据与EXCEL等联合工作2.机理分析:在MICRASOFT EXCEL 中与表对应的对象是工作表(sheet或worksheet)与每一个单元格对应的对象是单元格式(CELL).工作表对象中的CELLS属性它是以行(ROW)和列(GOLUMN)作为参数,对于行和列选择可采用变量形式,在本文中可设定工作表(WORKSHEET)的每个单元格CELL(i j )来操作工作表,( i 表示行数,j 表示列数,i ,j 都要为正整数)三. 具体实现方法1.1 AUTOCAD VBA 程序与EXCEL建立联接,并创建新EXCEL表 要在AUTOCAD中操作EXCEL,就必须利用VBA将EXCEL中的对象能让用户使用,就需要让AUTOCAD VBA引用EXEEL对象库操作步骤如下: 步骤1:在AUTOCAD(AUTOCAD2004以上版本)中打开VBA管理器,创建一个工程将其保存为“制表”。

      步骤2:进入VBA集成开发环境,双击“工程资源管理器”窗口中的THISDRAWING图标,打开代码窗口,选择“工具/引用”菜单项,打开如图3所示对话框,选中MICROSOFT EXCEL 12.0 OBJECT LIBRARY (EXCEL对象库,其版本与计算机上安装的OFFICE 版本有关,12.0是OFFICE2007对应的版本号),引用类型库实际上是向编译器表示本程序要使用一个已注册的组件,引用对象库后就可以在对象浏览器中观察对象库中的对象,方法和属性步骤3:完成对EXCEL对象库引用后,就可在程序中随时调用EXCEL中的对象可按如下代码来创建完整的EXCEL对象引用实例:Public excelapp As Excel.Application ‘定义EXCEL对象变量Public excelworkbook As Excel.Workbook ‘定义工作簿对象变量Public excelsheet As Excel.Worksheet ‘定义工作表对象变量Public Sub linkexcel() On Error Resume Next Set excelapp = GetObject(, "excel.application") If Err Then Err.Clear Set excelapp = CreateObject("excel.application") If Err Then Err.Clear MsgBox "请检查EXCEL" Exit Sub End If End If Set excelworkbook = excelapp.Workbooks.Add ‘创建新工作簿 Set excelsheet = excelworkbook.Worksheets("sheet1") excelapp.WindowState = xlMinimized ‘EXCEL程序窗口最小化 End Sub图31.2通过在AUTOCAD中提示用户进行鼠标和键盘的操作获得距离和高程数据,并将数据写入创建的EXCEL表中的指定单元格。

      由于纵横断面数据表格式不同,所以要分别用两个独立程序过程来完成1.2.1制作纵断面数据表的程序步骤可分为以下几步:步骤1:程序运行,提示用户用鼠标确定纵断面起点心(或第一点)并记录点位步骤2:提示用户鼠标确定断面点(或第二点)用户输入断面点后,程序计算与起点间平距并提示用户鼠标捕捉的点位高程是否正确,然后将平离和高程写入EXCEL指定单元格中步骤3:循环步骤2;如用户需要直接输入高程和距离,则输入对应关键字后(程序中为”a”),程序开始接受用户输入;如道路有拐点,用户可输入对应关键字,程序提示用户鼠标确定拐点(插入拐点后,程序跳至步骤1开始运行)步骤4:制作纵断面数据表完成,用户输入关键字(程序中为”e”),程序结束,并提示用户保存EXCEL文件制作纵断面数据表程序代码:Public Sub getzdm()Dim pt1 As Variant ‘定义点位变量Dim pt2 As Variant ‘定义点位变量Dim h As Variant ‘定义断面点高程变量Dim s As Single ‘定义断面点间距变量Dim strinput As String ‘定义用户输入高程和距离变量数组Dim strinput1 As Variant ‘定义用户输入高程和距离变量数组Dim i, j As Integer ‘定义引用EXCEL单元格的行列号变量Dim biaoji As AcadCircle '定义一个圆,标记鼠标捕捉的点位Dim bases As Single bases = 0 i = 1: j = 1Call linkexcel '调用linkexcel过程连接并创建EXCEL文件 On Error Resume Next '设置错误陷阱,如有错误执行下一行'选取第一点(纵断面起点)coledata1:Dim keywordlist2 As String keywordlist2 = "A E" '定义用户输入关键字ThisDrawing.Utility.InitializeUserInput 128, keywordlist2 pt1 = ThisDrawing.Utility.GetPoint(, "输入起点[输入距离高程(A)]/[完成(E)]:")‘判断用户输入的关键字,确定不同的运行方法 If Err Then If StrComp(Err.Description, "用户输入的是关键字", 1) = 0 Then strinput = ThisDrawing.Utility.GetInput ‘获得用户输入的关键字 If StrComp(strinput, "a", 1) = 0 Then strinput1 = ThisDrawing.Utility.GetPoint(, "输入距中桩[距离][高程]:") excelsheet.Cells(i, j) = strinput1(0) ‘EXCEL中写入里程 excelsheet.Cells(i, j + 1) = strinput1(1) ‘EXCEL中写入高程 i = i + 1 ‘EXCEL换行 Err.Clear ‘错误信息清除 GoTo coledata1 ‘程序跳至coledata1运行 ElseIf StrComp(strinput, "e", 1) = 0 Then MsgBox "断面数据已形成,请保存:-)" excelapp.Visible = True Set excelsheet = Nothing '释放对象变量 Set excelapp = Nothing '释放对象变量 Exit Sub End If End If End If '选取第二点(断面点)及输入高程Colsecond:Dim keywordlist5 As String keywordlist5 = "I E A" '定义用户输入关键字 ThisDrawing.Utility.InitializeUserInput 128, keywordlist5 pt2 = ThisDrawing.Utility.GetPoint(pt1, "输入第二点/[插入拐点(I)]/[输入距离高程(A)]/[完成(E)]:") '判断用户输入的关键字,确定不同的运行方法 If Err Then If StrComp(Err.Description, "用户输入的是关键字", 1) = 0 Then strinput = ThisDrawing.Utility.Get。

      点击阅读更多内容
      关于金锄头网 - 版权申诉 - 免责声明 - 诚邀英才 - 联系我们
      手机版 | 川公网安备 51140202000112号 | 经营许可证(蜀ICP备13022795号)
      ©2008-2016 by Sichuan Goldhoe Inc. All Rights Reserved.