AUTOCAD VBA在地形图及断面图成图中的应用
AUTOLISP程序生成CAD断面图
利用AutoLisp、Microsoft VBA程序语言实现批量生成断面图及断面电子表格数据蒋济飞赵新萍（广西第二测绘院广西柳州 545006）【摘要】本文主要讨论如何利用AutoCAD的二次开发语言AutoLisp 和Excel中的Microsoft VBA语言技术，利用地形图上的高程点数据批量生成断面图和断面数据表格。
【关键字】断面图 AutoLisp Microsoft VBA1 引言Visual Basic作为一个集成的开发环境，能够使AutoCAD数据与其它的Visual Basic应用程序，如Microsoft Excel软件，直接共享，实现无缝连接，交换数据。
在没有专业软件辅助的情况下，绘制纵横断面图是很繁琐的事，需要进行大量的、重复的操作，既劳神，又容易出错。
我们在完成老挝南塔河1#水电站进站道路测绘项目中，利用地形图上的高程点数据，通过Auto Lisp、Visual Basic编程建立AutoCAD与Excel的通信，实现数据交换，快速绘制公路纵横断面及相关成果表，大大的提高了工作效率。
2 应用程序的开发在实现对地形图上的高程点数据批量生成断面图和断面数据表格处理的程序代码编写过程中，主要分以下步骤：（1）注记纵、横断面交点的里程和高程并生成纵断面曲线，输出断面数据。
首先我们取得纵断面线折点的坐标集合（XY-List）。
如果纵断面线图元为LWPOLYLINE，则只要依次取出纵断面线图元数据中群码为10的数据即可；如果纵断面线图元为POLYLINE，则只要依次取出纵断面图元之后SEQEND之前的所有VERTEX图元数据中群码为10的数据即可。
取得纵断面线上所有高程点和横断面图元。
代码如下：（SETQ ALL-DATA（SSGET "F" XY-List ' （（-4 . "<or"）（-4 . "<and"）（0 . "INSERT"）（8 . "GCD"）（-4 . "and>"）（-4 . "<and"）（0 . "*POLYLINE"）（8 . "DM"）（-4 . "and>"）（-4 . "or>"））））取得高程点和横断面图元数据之后，对数据进行区分。
AutoCAD二次开发技术在工程测绘制图中的应用
AutoCAD二次开发技术在工程测绘制图中的应用摘要:简要介绍了进行AutoCAD二次开发的常用方法和技术特点,并以实例说明了利用VBA实现AutoCAD二次开发的实际价值和意义。
关键词: AutoCAD二次开发VBA 工程测绘制图坐标标注随着现代科学技术的迅猛发展，测绘科学也发生了翻天覆地的变化，测绘仪器和测绘技术都有了很大的发展，测绘仪器由原来的光学仪器、机械仪器发展到了电子仪器，图形绘制由铅笔平板仪绘制发展到计算机软件绘制。
电子仪器可通过专用传输线与计算机直接连接，把野外所采集的数据传输进计算机，在计算机中进行数字化成图。
以手工作业为主的测量内业计算与绘图工作已经可以通过电子仪器、计算机绘图仪完成。
数字化成图已经成为测图发展的主流方向。
目前市场上的数字成图软件有很多，测绘行业普遍使用的有南方测绘公司的CASS 系列、广州开思公司的SCS 系列，还有北京微远图公司的SV300 系列等软件,这些软件多是以AutoCAD为平台开发的, 它们主要针对的是测绘行业的通用性需求,在大体框架上基本满足了地形图、地籍图等测绘工作的成图要求。
但测绘性质的多样性，决定了不可能有适合所有测绘性质的数字成图软件，在实际工作中,一些制图工作在许多细节上的操作具有特殊性，并且随测绘性质和目的的不同而有所不同。
而且每个测绘员又各有各的工作方式和习惯.这些通用软件对一些特殊性质的处理控制和专业性强的特殊要求就不能满足了，怎样解决这个问题和要求,使数字化成图软件更符合自己工作要求呢?下面针对本单位经常进行的工程测量成图工作中遇到的问题,介绍解决基本方法与过程。
一.AutoCAD及二次开发简介1. AutoCADAutoCAD是美国Autodesk 公司开发的一个交互式绘图软件，具有开放的极其灵活的体系结构，它允许用户和开发者采用各种方法对其进行定制、扩充和修改，即用户自己可以对进行二次开发,能最大限度地满足用户的特殊要求。
基于VBA处理AutoCAD中断面数据的方法研究
基于VBA处理AutoCAD中断面数据的方法研究AutoCAD是一款专业性很强的CAD绘图软件，广泛应用于工程建设、制造、设计等领域。
在AutoCAD中，断面数据是指通过对三维对象进行切割，产生的平面二维图形，其包含了构成三维对象的各个面的基本信息，如直角坐标系下的坐标、面积及法向量等。
处理断面数据在建筑结构设计、工程测量、都市规划等领域都是非常重要的一个环节。
本文主要是从基于VBA处理AutoCAD中断面数据的角度进行探讨，包括方法、技巧和问题等方面的阐述。
一、AutoCAD中断面数据的提取在AutoCAD中，断面数据可以通过切割三维对象得到，常用的方法有截面命令、视觉样式和面板命令等。
其中，截面命令和视觉样式命令提取的数据文件只包含视图中可见的部分，而面板命令可以提取整个三维模型的断面数据，但需要手动指定切割位置。
故在实际工程中，可以根据实际需求选择不同的命令进行数据提取。
二、VBA的开发环境VBA(Virtual Basic for Applications)是一种微软开发的基于Visual Basic的应用程序编程语言，可以嵌入Excel、Access、Word和AutoCAD等软件中进行开发。
AutoCAD提供了一个强有力的VBA开发环境，可以通过VBA语言在AutoCAD中进行各种自定义的开发和操作。
三、基于VBA处理AutoCAD中断面数据的方法研究在使用VBA处理AutoCAD中的断面数据时，常用的方法有两种，一种是利用VBA程序对AutoCAD中断面数据进行批量处理，另一种是基于事件机制对AutoCAD中断面数据进行交互式处理。
1、批量处理批量处理是指利用VBA程序来对AutoCAD中多个文件的断面数据进行批量处理，其具体实现方法可以分为两步：先调用AutoCAD中的断面命令将原始三维模型切成多个断面，再根据提取的断面数据文件，进行数据处理和分析等操作。
VBA 批量处理的优点是可以大大节省时间和精力，实现高效、准确地处理大量数据文件；缺点是需要一定的编程基础和程序开发能力，调试周期相对较长。
QC EXCEL VBA及Auto lisp编程语言在快速绘制路基断面图中的应用
EXCEL VBA及Auto lisp编程语言在快速绘制路基断面图中的应用中铁x局集团第二工程公司长益项目编程绘图QC小组一、工程概况G5513长沙至益阳高速公路扩容工程是为增加长沙主城区对外出入口，增加长株潭城市群对外辐射通道，提质、扩能“长益常张”经济走廊长益段的交通通道，是分流长益高速及G319车流而新辟的另一快捷、畅通的交通要道，同时也是湖南省“绿色公路”典型示范工程。
二、QC小组概况为研究如何高效、快捷、准确的核对路基土石方工程量，节省项目前期这一工作的人力物力的投入，我们成立了长益项目编程绘图QC小组，对自主编程核对土石方工程量进行攻关，小组具体情况见下表：制表人：x 制表时间：2017年5月31日四、设定目标及可行性分析(1)设定目标研究出简单易操作、工效高的绘图程序；实现CAD中的一键自动绘图并标注，为项目核对土石方量提供一种全新便捷的方法。
(2)可行性分析经过大量调查与分析，通过EXCEL中内置公式以及函数的应用，可以快速算出断面图的各个坐标，通过VBA编程语言再进行大批量数据的处理，可一次处理多个断面坐标，并自动计算出断面面积，再通过Autolisp编程语言对CAD进行二次开发可一键实现断面图中自动标注。
综上所述，小组认为能够实现目标！！！五、初步调查及提出方案在高速公路项目上，项目前期会对原地面进行复测并以此核对土石方工程量，目前绝大多数项目核对路基土石方工程量需人工根据图纸标高坡度等信息计算画出每个断面的CAD图，再在CAD中查看断面面积以此核对设计的工程量，此方法需投入大量的人力和精力，且在绘制的过程中易出错，效率低。
目前网上可能存在一些软件可以自动出图，但是正版软件的费用很高，而且破解版的软件种类繁多，操作不便，难以找寻到合适的，有些软件甚至被植入恶意程序。
由于EXCEL软件比较常用，且内置了VBA编程环境，通过VBA编程可以自动完成大量重复的工作，初步考虑以通过EXCEL内置的函数公式等，自动计算出路基断面图关键位置的相对坐标和每个断面的面积，再通过VBA程序批量处理多个断面的数据，联合CAD的绘图命令等实现一键绘图。
基于VBA在AutoCAD中自动绘图的应用
基于VBA在AutoCAD中自动绘图的应用------李广亚随着电脑技术的飞速发展，目前大多数企业都采用AutoCAD制图、绘图，在工程施工领域也是采用AutoCAD进行二维工程绘图。
GPS的应用使的施工现场坐标的采集非常方便，通常便于直观，监理、业主会要求将GPS采集的坐标绘制在CAD图上。
对于一个熟悉CAD的人来说，将10几个坐标数据手工录入坐标绘制到CAD中是比较容易的，但如果是几十个点，上百个点，甚至几百个点，对于一个施工技术员来说一个一个坐标的手工录入，就成了一个比较有难度的工作，主要因为手工录入会比较繁琐、耗费时间长还特别容易出错。
在这方面如何能提高技术人员的工作效率？基于此，我们采用AtuoCAD中的VBA技术，进二次开发，可以方便的将大量的坐标自动绘制到CAD图中。
下面通过一个简单事例来说明AtuoCAD中VBA技术的二次开发自动绘图程序的过程： 事件介绍：2012年业主在场区开挖一不规则多边形鱼塘，要求我单位将鱼塘进行测量并标注在总平面图上。
1、数据采集：使用GPS现场进行数据采集，在鱼塘周边从一点开始，顺时针方向进行，在不规则鱼塘的所有角点拐点均采集坐标，并保存在GPS中。
2、导出坐标：将GPS中采集的坐标导出到文本文档，如下图：3、数据处理：将导入的坐标使用EXCEl文档打开并编辑处理，高程全设为0，表单重命名为“SJ”，保存EXCEl文档到D盘，文档名称为“GPS导入坐标绘图”如下图：4、VBA跨平台技术二次开发：（1）、打开AutoCAD，选择工具->宏->VBA编辑器，打开VBA编辑器。
在VBA编缉器中插入用户窗体，在窗体上插入按钮组件，如图：（2）、双击按钮，打开代码编辑窗口，编缉代码如下：Private Sub CommandButton1_Click()Dim xlapp As Excel.ApplicationDim xlbook As Excel.workbookDim xlsheet As Excel.worksheetSet xlapp = CreateObject("excel.application")Set xlbook = xlapp.workbooks.Open("D:\GPS导入坐标绘图.xls")'打开的EXCEL路径xlapp.Visible = FalseSet xlsheet = xlbook.worksheets("sj") '打开EXCEL中的sj工作表i = xlsheet.Cells(1, 2) 'i为线条线数For p = 0 To i - 2 Step 1p = pk1 = xlsheet.Cells(3 + p, 3) '将表格第3行第3列内数值赋值给K1，X坐标值h1 = xlsheet.Cells(3 + p, 2)k3 = xlsheet.Cells(3 + p, 4)k2 = xlsheet.Cells(4 + p, 3)h2 = xlsheet.Cells(4 + p, 2)h3 = xlsheet.Cells(4 + p, 4)Dim 点 As AcadLineDim 起点(2) As DoubleDim 端点(2) As Double起点(0) = k1 '将K1值贱赋值给起点数组内第一个值，即起点X坐标。
论文-在AUTOCAD中,利用VBA编程绘制抛物线断面图
在AUTOCAD 中，利用VBA 编程绘制抛物线断面图张松华 吕明（湖北省输变电工程公司，武汉市，430063）[摘 要] 文章介绍了在AUTOCAD 中，利用VBA 编程求解抛物线方程的原理和方法，并结合抛物线断面图的两种典型应用，对AUTOCAD 的具体定制作出进一步说明。
[关键词] AUTOCAD VBA 抛物线 断面图VBA 是Visual Basic for Application 的缩写，由Visual Basic 派生而来。
与VB 一样，VBA 是面向对象的程序设计语言，它继承了VB 语言简单，功能强大的特点。
每一套AUTOCAD 都包含VBA 程序开发环境，这个集成开发环境提供了高质量的用户化编程能力。
在输变电放线施工中，经常需要计算放线张力及绘制断面图。
技术人员通常采用手工方式完成这些工作，效率比较低。
其具体做法一般是在已知抛物线方程的情况下，结合EXECLE ，计算出一系列点的坐标，再将这些点坐标的数据复制粘贴到AUTOCAD 中绘制样条曲线，一次生成抛物线曲线。
本文介绍的方法是利用VBA 技术对AUTOCAD 进行二次开发，使上述问题的解决变得更加简单、非常直观，而且还能实现更多的功能。
1. 基本方法及应用抛物线的普通方程为（y+a ）=k(x+b)2，方程中有三个未知数a 、k 、b ，因此代入三个点的坐标（x1’,y1’）、（x2’,y2’）、（x3’,y3’），通过解三联方程组，即可解出抛物线方程式。
为了简便求解过程，可以先将抛物线进行平移，使第一点（x1’,y1’）成为抛物线原点，平移后第二点和第三点坐标分别变为（x2=x2’-x1’,y2=y2’-y1’），（x3=x3’-x1’,y3=y3’-y1’）。
设平移后抛物线方程为(y+a)=k(x+b) 2，则其中的k=x2)-(x3 x3x2y2 x3- y3 x2⨯⨯⨯⨯，b= x2k 2x2k - y22⨯⨯，a ＝k ×b 2。
AutoCAD与Excel的VBA技术在管道纵断面绘制中的应用
２ Ａ ｔＣ Ｄ 与 Ｅ ｃｌ ｕｏ Ａ ｘｅ 的数据 交换
同的办 法 ， 复性 强 。虽 然 已有 不少 辅助 设计 的商 重
Ｅ ｃ １ 持 Ａｃｉｅ Ａｕｏ ｔ ｎ接 口，用户 可 ｘｅ支 ｔ Ｘ ｔｍａ ｏ ｖ ｉ
业 工具 软件 ， 鸿业 、 如 理正及 天正 等 ， 但使 用起来 总
最顶 层对 象 ， Ｖ Ａ应 用程 序 的运行 环境 ， 是 Ｂ 其他对 象均 为它 的子对 象 。 （） ｒｂ ｏ ｓＷｏｋ ｏ ｋ 对象 。一个 Ｗｏｋ ２ Ｗｏｋ ｏ ｋ （ ｒｂ ｏ ） ｒ． ｂ ｏ 象实 际上就 是一 个 Ｅ ｃｌ 件 ， ｘ ｅ 程序 ｏ ｋ对 ｘｅ文 Ｅ ｃｌ 可 以同时打开或 创建 多个 文件 ， 它们被保存 在 Ｗｏ． ｒ ｋ ｏ ｋ 集 合对 象 中， 以通过 索 引号或名 称访 问 。 ｂ ｏｓ 可 （ ） ｒ ｓｅｔ（ ｒｓｅ ｔ对 象 。一个 Ｗｏｋ ３ Ｗｏｋｈ ｅｓＷｏｋｈ ｅ） ｒ ｓｅｔ 象对 应于 一个 工作表 ， ｒｓｅ ｔ 象 的集 ｈｅ对 Ｗｏｋｈ ｅ 对
程” 插入文 字 点的坐 标为（０ ５ ０ ， 字高度 为 ５ ， ３ ， ，）文 。
Ｄｉ ｌ ｅ ｊ ｃ ｄ ｉ ｍ ｎ Ｏｂ Ａｓ ａ Ｌｎ ｉ Ａ ｅ
（）Ｒ ｎ ｅ 象 。Ｒ ｎ ｅ 象用 来 指定工 作表 ４ ａｇ 对 ａｇ 对 上 的区域 ， 以是一 个或 多个 单元 格 。 可 ２ ｔＣ ． Ａｕｏ ＡＤ 中读取 Ｅ ｃｌ 据 ２ ｘｅ数 Ａｕｏ ＡＤ与 Ｅ ｃｌ ｔＣ ｘ ｅ 的数 据交 换 ， 需要 加载 Ｅ ． ｘ ｃｌ ｃｉｅ 对象 模 型 。首 先 ，按 Ａｌ Ｆ １ ｅＡｔ Ｘ ｖ ｔ １ 组合 键 ， ＋ 打开 Ａ ｔＣ Ｄ 的 Ｖ Ａ 编辑 器 ； ｕｏ Ａ Ｂ 然后 在 ＶＢ Ａ编 辑 器 窗 口中选 择 “ 工具 ”菜单 的 “ 引用” ，选择加 载 “ ｃｏｏｔ ｘ ｅ １ ．Ｏｂｅｔ ｉｒｒ ” （ ｘ ｅ ０ ３ Ｍｉ ｓ ｆＥ ｃｌ ０ ｊｃ Ｌｂａｙ 项 Ｅ ｃｌ ０ ｒ ０ ２
AutoCAD VBA自动获取Excel数据生成塔基断面图
AutoCAD VBA编程：自动获取Excel数据生成塔脚断面图原以为这辈子再不会写程序了，无奈，还得继续……1、测量原始数据、处理结果。
如图：2、原始数据录入Excel ,并整理如下格式：3、因断面图用于设计高低柱、长短腿，在AutoCAD里面只生成A、B、C、D四个腿、以及横线路方向（E）即可。
在CADVBA程序管理器中录入以下程序段：Sub yema()Dim xcelApp As Excel.ApplicationDim xcelSheet As Excel.WorksheetDim strFile As StringstrFile = ThisDrawing.Application.VBE.ActiveVBProject.FileNameSet xcelApp = CreateObject("Excel.Application")xcelApp.Workbooks.Open Left$(strFile, Len(strFile) - 11) & "test.xlsx", , ReadOnly Set xcelSheet = xcelApp.ActiveWorkbook.Sheets(1)Dim mytxt As AcadTextStyleSet mytxt = ThisDrawing.TextStyles.Add("standard")mytxt.fontFile = "c:\windows\fonts\SIMFANG.TTF"ThisDrawing.ActiveTextStyle = mytxt'Dim newl, newl1, xxyLine, xxxLine As AcadSpline'取消顺线路方向Dim newl, newl1, xxyLine As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoublestartTan(0) = 0: startTan(1) = 0: startTan(2) = 0endTan(0) = 0: endTan(1) = 0: endTan(2) = 0Dim ptArr(0 To 92) As DoubleDim ptArr1(0 To 92) As DoubleDim ptArr2(0 To 92) As Double'Dim ptArr3(0 To 92) As DoubleDim i, j As Integeri = 1j = 0Do While i < 32ptArr(j) = xcelSheet.Range("C" & i): ptArr(j + 1) = xcelSheet.Range("D" & i): ptArr(j + 2) = 0ptArr1(j) = xcelSheet.Range("G" & i): ptArr1(j + 1) = xcelSheet.Range("H" & i): ptArr1(j + 2) = 0ptArr2(j) = xcelSheet.Range("K" & i): ptArr2(j + 1) = xcelSheet.Range("L" & i): ptArr2(j + 2) = 0'ptArr3(j) = xcelSheet.Range("O" & i): ptArr3(j + 1) = xcelSheet.Range("P" & i): ptArr3(j + 2) = 0i = i + 1j = j + 3LoopSet newl = ThisDrawing.ModelSpace.AddSpline(ptArr, startTan, endTan)Set newl1 = ThisDrawing.ModelSpace.AddSpline(ptArr1, startTan, endTan)Set xxyLine = ThisDrawing.ModelSpace.AddSpline(ptArr2, startTan, endTan)'Set xxxLine = ThisDrawing.ModelSpace.AddSpline(ptArr3, startTan, endTan) newl.color = acRednewl1.color = acYellowxxyLine.color = acBlue'xxxLine.color = acBlueDim aText, cText, bText, dText As AcadTextDim txtP(0 To 2) As DoubletxtP(0) = ptArr(0) + 20txtP(1) = ptArr(1)txtP(2) = 0Set aText = ThisDrawing.ModelSpace.AddText("A", txtP, 800)txtP(0) = ptArr(90) - 20txtP(1) = ptArr(91)txtP(2) = 0Set cText = ThisDrawing.ModelSpace.AddText("C", txtP, 800)txtP(0) = ptArr1(0) + 20txtP(1) = ptArr1(1)txtP(2) = 0Set bText = ThisDrawing.ModelSpace.AddText("B", txtP, 800)txtP(0) = ptArr1(90) - 20txtP(1) = ptArr1(91)txtP(2) = 0Set dText = ThisDrawing.ModelSpace.AddText("D", txtP, 800)'画坐标Dim xLine As AcadLineDim yLine As AcadLineDim stPoint(0 To 2) As DoubleDim enPoint(0 To 2) As DoublestPoint(0) = -20000: stPoint(1) = 0: stPoint(2) = 0enPoint(0) = 20000: enPoint(1) = 0: enPoint(2) = 0Set yLine = ThisDrawing.ModelSpace.AddLine(stPoint, enPoint)stPoint(0) = 0: stPoint(1) = -13000: stPoint(2) = 0enPoint(0) = 0: enPoint(1) = 13000: enPoint(2) = 0Set yLine = ThisDrawing.ModelSpace.AddLine(stPoint, enPoint)'加坐标度ThisDrawing.SetVariable "PDMODE", 2ThisDrawing.SetVariable "PDSIZE", 300Dim zbPoint As AcadPointDim zbTxt As AcadTexti = -15Do While i < 16stPoint(0) = i * 1000: stPoint(1) = 0: stPoint(2) = 0Set zbPoint = ThisDrawing.ModelSpace.AddPoint(stPoint)stPoint(0) = i * 1000: stPoint(1) = -700: stPoint(2) = 0If i < 0 ThenSet zbTxt = ThisDrawing.ModelSpace.AddText(-i, stPoint, 250) ElseSet zbTxt = ThisDrawing.ModelSpace.AddText(i, stPoint, 250) End Ifi = i + 1Loopi = -6Do While i < 7stPoint(0) = 0: stPoint(1) = i * 2000: stPoint(2) = 0Set zbPoint = ThisDrawing.ModelSpace.AddPoint(stPoint)stPoint(0) = -650: stPoint(1) = i * 2000 - 100: stPoint(2) = 0Set zbTxt = ThisDrawing.ModelSpace.AddText(i, stPoint, 250)i = i + 1Loop'加塔号、塔型Dim titTxt As AcadTextstPoint(0) = 1000: stPoint(1) = -10000: stPoint(2) = 0Set titTxt = ThisDrawing.ModelSpace.AddText(xcelSheet.Range("B32") & "(" & xcelSheet.Range("B33") & ")", stPoint, 800)ThisDrawing.Application.UpdateZoomAllxcelApp.ActiveWorkbook.ClosexcelApp.Workbooks.ClosexcelApp.QuitEnd Sub4、运行结果如下图（OK）：。
在AutoCAD2000中应用VBA技术自动绘制等高线
在AutoCAD2000中应用VBA技术自动绘制等高线王永新福州市土地管理局计算机中心 350004摘要：应用AutoCAD进行地形图的计算机辅助制图能够极大地提高工作效率，但其没有自动生成等高线的功能，本人用VBA技术，将外业采集的离散点通过建立三角网，在三角形边上内插等高点的方式，能够在AutoCAD中实现等高线的自动绘制。
内容：VB是最为常用的支持ActiveX Automation技术的开发工具，其语法简单、功能强大。
VBA是VB的子集，由于AutoCAD2000的VBA是嵌入在AutoCAD 内部的，共享AutoCAD内存空间，可以很好地与AutoCAD沟通。
运用VBA 技术自动绘制等高线将极大地提高绘图效率，缩短项目的周期。
平面等高线自动绘制有很多方法，其中较为简单和比较常用的是三角网法。
用三角网方法绘制等高线包括四个主要过程：根据离散分布的数据点（离散点）建立不规则的三角形网；在三角形边上内插等高点；找等高线的起迄点并追踪全部等高点；连接等高点绘成光滑曲线。
下面介绍三角网法绘制等高线具体的算法过程。
一、建立三角网假设在AutoCAD模型空间的平面上已经有n个离散点，点的类型为具有3D坐标的Point实体。
为了保证等值点内插的精度，要使形成的每个三角形尽可能呈锐角三角形，并保证各个三角形之间互不交叉且不重复。
具体联结的方法是：1、确定第一个三角形设L为每次自动连成的三角形编号，K为每次用来扩展的三角形编号。
首先设L=1，从n个离散点中找出左下角的点赋给Ver(L,1)，作为第一个三角形的第一个顶点，找出距离该点最近的点赋给Ver(L,2)，作为第一个三角形的第二个顶点，找出距离这两点连线中点最近且不和这两点在一条直线上的点赋给Ver(L,3)，作为第一个三角形的第三个顶点。
这样，就形成一号三角形的顶点信息，K=1。
2、三角形扩展由第一号三角形向外扩展，直到将全部的离散点连成三角网的过程是：首先从K 号三角形的第一条边（Ver(K,1)、Ver(K,2)）向外扩展，为了避免三角形的交叉，以第一条边为界，显然，位于顶点Ver(K,3)同侧的离散点必须被排除，（见图1），利用直线判别正负区的原理可以实现这一要求。
基于VBA技术的AutoCAD二次开发在地形图绘制中的应用_李志锐
第23卷第10期2007年10月农业工程学报T ransactio ns o f the CSAE V o l.23 No.10O ct. 2007基于VBA 技术的A utoCAD 二次开发在地形图绘制中的应用李志锐1,2,李法虎1(1.中国农业大学水利与土木工程学院,北京100083; 2.山东省东明县建设局,山东274500)摘 要:地形图绘制是农业工程领域生产实践活动中经常遇到的基础性工作。
传统的地形图绘制需要大量的手工作业,效率较低。
该文以V BA (V isua l Basic for A pplicatio n )为开发平台,对A uto CA D 应用软件在地形图绘制中的应用进行了二次开发,从而实现了区域地形点的自动展绘。
结合工程应用实例,探讨了运用A ut oCA D 内置的V BA 进行二次开发的方法和过程。
程序运行结果显示,该文介绍的方法占用内存小,自动化程度和工作效率高,适用范围广,可自动完成各类地形点的展绘工作,从而为各类地形图的自动绘制奠定了基础。
关键词:A uto CA D ;V BA ;二次开发;地形图中图分类号:T P391.72 文献标识码:A 文章编号:1002-6819(2007)10-0025-06李志锐,李法虎.基于V BA 技术的A ut oCA D 二次开发在地形图绘制中的应用[J ].农业工程学报,2007,23(10):25-30.L i Zhir ui,Li Fahu.Ex tended applicat ion o f A ut oCA D on t he m ap-making based on V BA technolog y [J].T r ansa ct ions of the CSAE ,2007,23(10):25-30.(in Chinese w ith English abst ract)收稿日期:2006-08-13 修订日期:2007-08-14作者简介:李志锐(1976-),男,工程师,主要从事地形图绘制、土地利用和城镇规划方面的研究。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
AUTOCAD VBA在地形图及断面图成图中的应用
一、前言
现在有很多绘制地形图以及平断面图的软件，地形图软件一般是在Autocad的平台上进行二次开发。
平断面图则一般通过软件的操作平台，根据其数据文件生成可读写的DXF 文件或是DWG文件，如道亨软件在图生成后常常还要进行必要的修改，修改中常常要进行重复繁琐的操作，对此利用VBA 语言可以帮助我们完成这些工作。
二、地形图中的应用
（一）地形图的等高线失真原因
在测量的过程中，对于高差起伏比较大的地形，在内业过程中要进行等高线的绘制，但是在等高线的绘制过程中，读入原始测量数据建立DTM，三角网构建方式采用算法如图1所示：
1、在所采集的离散点中任意找一点，然后查找距此点最近的点，连接后作为初始基线。
2、在初始基线右侧搜寻第三点，具体的做法是：在初始基线右侧的离散点中查找距此基线距离最短的点，作为第三点。
3、生成Delaunay 三角形，再以三角形的两条新边（从基线起始点到第三点以及第三点到基线终止点）作为新的基
线。
4、重复步骤2、3直至所有的基线处理。
因此三角网的连接的随机性、测量人员的跑点方式和实际地形的复杂程度共同造成了地形图的失真。
如图2所示红色集水线所示为真实的沟底的走向，由于立尺人经验欠缺或是失误在没有E点采集数据，因此形成了图中B点与D点成一个深坑的形状，造成了地形图的失真，而用手工去修剪这样复杂的等高线常常需要修改三角网，但因为采用的线型及整体因素变得非常复杂而工作量相当的大。
（二）编写程序的过程
为了提高内业的工作效率，本人利用文件写入测量的原始数据，并利用软件重新绘制等高线。
本人利用VBA读写测量的原始数据文件的，编制一个子过程即宏运行，编写的思路如下：
pfile = UserForm1.dd.FileName ‘调用一个窗体对话框，选择测量原始数据并进行文件写入
If pfile = "" Then
Exit Sub
End If
ThisDrawing.Utility.InitializeUserInput 0, "0 1 2 3"‘在CAD 命令提示行里选择坐标值位数
options = ThisDrawing.Utility.GetKeyword(vbCrLf &
"选择坐标值的保留位数[零位(0)/一位(1)二位(2)/三位(3)]:")
pa = ThisDrawing.Utility.GetString(0, vbCrLf & "请你输入起始位置编号：")
’输入测量原始数据的序号
Open pfile For Append As #1
On Error GoTo dd
For kk = 1 To 1000
ca = ThisDrawing.Utility.GetString(0, vbCrLf & "请你输入内插高程：")
‘在命令提示符输入内插点的高程
wd = ThisDrawing.Utility.GetPoint(, "请你点取图面位置：") ‘获取当前选择点的图面坐标值
If options = "" Then 仅以不输入坐标位数取三位为例
ak1 = Format(wd(0), "0.000")
ak2 = Format(wd(1), "0.000")
ak3 = ca
end if
jj = (Trim(pa)) & ",," & ak1 & "," & ak2 & "," & ak3
pa = Str(Val(pa) + 1)
Print #1, jj
Next kk
Close #1
End Sub
（三）程序运行及结果
图2所示为内插红点所示的1211.33的标高后，计算机重新绘制等高线线后的地形图。
一般在地形图成图软件中读入经过内插后的测量原始数据，重新形成三角网，并初步成等高线，同时检查三角网形成合理与否。
对于地形起伏很大，沟壑较多的地方因为常常并不能一次就能够修改完毕，因此需要外业人员配合内业人员对原有的地形点进行加密，内插并重新形成与现场实地相符合的等高线。
三、平断面图中的应用
（一）平面中增加地物
平面中增加地物程序代码
选取某断面图运行该宏代码，显示结果如图4所示
jp = ThisDrawing.Utility.GetPoint(, "程序提示你选择平面中线点:")
jp1 = ThisDrawing.Utility.GetPoint(, "程序提示你选择起点:")
jp2 = ThisDrawing.Utility.GetPoint(, "程序提示你选择端点:")
di = jp2(0) - jp1(0)
ci = di / 30
b1(0) = jp1(0)
b1(1) = jp(1) - 5
For i = 0 To ci - 1
b1(0) = jp1(0) + i * 30 ‘ b1表示与插入旱地图元的位置
b1(1) = jp(1) - 5
Set blobj = ThisDrawing.ModelSpace.InsertBlock(b1, "E:\Program Files\AutoCAD 2004\tuk\hd.dwg", 1, 1, 1, 0)
blobj.color = acYellow
Next i。