CAD算点号程序(VBA)
cad平台上测绘中VBA展野外点点号和方位角
下面就是自动在AutoCAD中画点的Visual Basic程序代码(部分),最后将其制作成可执行文件(e: \展点.exe)供AutoCAD菜单宏调用。
假若数据采集格式为:点号,X坐标,Y坐标, Z(高程)Open数据文件名For Input As #1set Points = yers.Add(/点0)-增加/点0图层Points.Color = acBlueSet Heights = yers.Add(/高程0)-增加/高程0图层Heights.Color = acGreenSet nos = yers.Add(/点号0)-增加/点号0图层nos.Color = acRedDo While Not EOF(1)Input #1, NO, x, y, z -将文件中数据分别附值给这几个变量Pt(0) = y: Pt(1) = x: Pt(2) = 0 -测量坐标系与AutoCAD坐标系的区别Set AdPoint = modelobj.AddPoint(Pt) -在模型空间中画点yer =/点0SetAdNO = modelobj.AddText(Str(NO), Pt, 1#)-在模型空间中绘制点号yer =/点号0Ht(0) = y + 0.9: Ht(1) = x: Ht(2) = 0Set AdHeight = modelobj.AddText(Str(z), Ht, 2#) yer =/高程0LoopClose #1acapp1.Application.ZoomExtentsForm1.Visible = FalseEnd Sub将展成的点连线的VBA代码为:Set PtLine = yers.Add(/点连线0) PtLine.color = acCyanDim kDim Coord As VariantFor Each entry In ThisDrawing.ModelSpaceIf entry.EntityType = acPoint Theni = i + 1End IfNext -获取模型空间中的点数目ReDim entrycopys(i -1, 2) -根据获得的点数目重新定义数组维数k = 0For Each entry In ThisDrawing.ModelSpaceIf entry.EntityType = acPoint ThenCoord = entry.Coordinates -获取实体坐标entrycopys(k, 0) = Coord (0)entrycopys(k, 1) = Coord (1)entrycopys(k, 2) = Coord (2)k = k + 1End IfNextDim StPt(0 To 2) As DoubleDim EtPt(0 To 2) As DoubleFor j = 1 To i -1StPt(0) = entrycopys(j -1, 0)StPt(1) = entrycopys(j -1, 1)StPt(2) = entrycopys(j -1, 2)EtPt(0) = entrycopys(j, 0)EtPt(1) = entrycopys(j, 1)EtPt(2) = entrycopys(j, 2)Set Lines = ThisDrawing.ModelSpace.AddLine(StPt, EtPt)-将当前点与前一个点连线yer =/点连线0Next jThisDrawing.Application.ZoomExtents如果要在Visual Basic环境中写入程序,则只要将VBA中的ThisDrawing对象改为AutoCAD对象的活动文件对象,就可以执行相同的操作,但由于是外部程序,执行速度将会慢一些。
CADVBA初级教程（全）
第一课：入门1.为什么要写这个教程市面上ACAD VBA 的书不多，它的帮助是英文版的，很多人看不懂。
其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
2.什么是AutocadVBA？VBA 是Visual Basicfor Applic ation s 的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VB A 就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
3、VBA 有多难？相信大家都知道Basi c 是的含义。
应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。
4、怎样学习VBA？介绍大家一个学习公式：信心+恒心=开心。
仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。
本教程将陆续发布在CA D 世界论坛上，您不需要付费就可以学习。
本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。
我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
5、现在我们开始编写第一个程序：画一百个同心圆第一步：复制下面的红色代码第二步：在模型空间按快捷键Al t+F8，出现宏窗口第三步：在宏名称中填写C100，点“创建”、“确定”第四步：在Sub c100()和End Sub 之间粘贴代码第五步：回到模型空间，再次按Alt+F8，点击“运行”Sub c100()Dim cc(0 To 2) As Double '声明坐标变量cc(0) = 1000 '定义圆心座标cc(1) = 1000cc(2) = 0For i = 1 To 1000 Step 10 '开始循环Call ThisDr awing.ModelS pace.AddCir cle(cc, i * 10) '画圆Next iEnd Sub也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。
AutocadVBA初级教程
AutocadVBA初级教程第二课编程基础本课要紧任务是对上一课的例程进行详细分析下面是源码：Sub c100()Dim cc(0 To 2) As Double '声明坐标变量cc(0) = 1000 '定义圆心座标cc(1) = 1000cc(2) = 0For i = 1 To 1000 Step 10 '开始循环Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆Next iEnd Sub先看第一行和最后一行：Sub C100()……End SubC100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub和end sub之间的所有指令。
第二行：Dim cc(0 To 2) As Double '声明坐标变量后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它可不能阻碍程序运行，它的作用是告诉阅读者程序员的方法。
关于简单的程序，一样不需要写注释，假如要编写专门复杂的程序，最好要多加注释，越详细越好，关于程序员来说，这是一个好适应。
电脑真正编译执行的是这条语句：Dim cc(0 To 2) As Double它的作用确实是声明变量。
Dim是一条语句，能够明白得为运算机指令。
它的语法：Dim变量名As 数据类型本例中变量名为CC，而括号中的0 to 2声明那个CC是一个数组，那个数组有三个元素：CC(0)、CC(1)、CC(2)，假如改为CC(1 to 3)，则三个元素是CC(1)、CC(2)、CC(3)，有了那个数组，就能够把坐标数值放到那个变量之中。
Double是数据类型中的一种。
ACAD中一样需要定义坐标时就用那个数据类型。
在AC AD中数据类型的有专门多，下面两个是比较常用的数据类型，初学者要有所明白得。
Long（长整型），其范畴从-2,147,483,648 到2,147,483,647。
CAD中的VBA简介
CAD中的VBA简介当用VBA开发基于AutoCAD的应用程序时，几乎总是在重复下面的几种工作：（1）创建和编辑实体。
作为计算机设计软件，AutoCAD最主要的工作时完成设计目标并为下一阶段的实际制造提供参考。
图纸仍然时其主要的工作产品，因而大部分的二次开发应用程序最终都要将结果用图形实体表现出来，这时AutoCAD二次开发的一个基础。
（2）和用户交互。
应用程序本身可以通过窗体或者命令行完成和用户交互。
比较特殊的时与图形相关的用户交互，列如提示用户选择一条多段线、输入一个整数、输入一个角度值等。
（3）利用队形特性来组织实体。
AutoCAD作为一种CAD软件，其内在的特点决定了所有的图形实体不具有属性特征。
也就是说，如果绘制一条直线来作为一条道路，在AutoCAD中是无法标识出他是一条道路的，通常的解决方法是创建一个名为“道路”的图层，然后将所有的代表道路的线都放在这个图层中统一管理。
（4）处理图形文件，在文件之间交换数据。
在进行设计是，把所有的图形元素放在一个图形文件中并不总是个好主意，最常见的后果就是图形文件太大导致操作起来太慢。
解决这个问题的办法就是按某种法则将图形元素分布到几个图形文件中，在需要的时候交换图形文件之间的数据。
（5）视图管理。
在AutoCAD中绘图时，为了便于计算和观察图形，人们总时会很频繁地改变视图，列如缩放、平移或改变视点。
而在开发VBA应用程序时，这方面的要求相对来说会低一点，一般只需在创建实体之后给出一个合适的观察角度即可。
（6）文字。
在AutoCAD的基本图形元素中，文字是比较简单的一个，但是在实际使用中它的可变性最大。
列如，不同类型的说话需要不同的文字样式，还有一些特殊的符号以及行为公差都是通过文字来表现的。
（7）管理块的属性。
块是将若干个图形对象定义成一个组，在需要的地方可以多次引用它。
这带来两个好处，一是减小图形的尺寸，二是修改起来方便，只需要修改块的定义便可以更新所有引用。
AUTOCAD编号和对齐VBA程序(500个对象)
houzui = ThisDrawing.Utility.GetString(True, "输入后缀（字符串）：")
On Error Resume Next
shunxu = ThisDrawing.Utility.GetInteger("输入顺序(1增序/2减序）：")
Case 3
str_temp$ = "000" + CStr(i)
Case 4
str_temp$ = "0000" + CStr(i)
Case 5
str_temp$ = "00000" + CStr(i)
suoyin(0) = arr_suoyin(0)
zuobiao(0) = arr_zuobiao(0)
For jp = 1 To duixiangshu Step 1
For jpp = 0 To duixiangshu Step 1
If arr_zuobiao(jp) >= zuobiao(jpp) Then
Case 3
str_temp$ = "000" + CStr(i)
Case 4
str_temp$ = "0000" + CStr(i)
If shunxu = "" Then shunxu = 1
'zengliang = ThisDrawing.Utility.GetReal("输入增量(实数)：")
Autocad VBA初级教程(4 程序的调试和保存)
Autocad VBA初级教程 (第四课程序的调试和保存)作者：普天同庆 | 阅读次数：675 转自：CAD世界网-论坛时间：2005年5月30日15:37人非圣贤，孰能无过，初学者在编写复杂程序时往往会出现一些意想不到的错误，所以程序的调试显得尤为重要，随着学习的深入，以后我们需要经常进行程序调试。
事实上，对于那些资深程序员来说，调试程序也是一项不可或缺的重要工作。
首先，在程序输入阶段，应该充分利用VBA编辑器的智能功能。
当你在写代码时，输入一些字母后，编辑器可以自动列出合适的语句、对象、函数供你选择，可以用上下键选择，然后按TAB键（它位于“Q”键左边）确认。
当输入一个回车符后程序会自动对这条语句进行分析，如果出现错误就会提示。
我们经常碰到的麻烦是程序的运行结果和预计的不一样，一般我会这样做：首先要想一想可能是哪一个变量有问题，然后去监视这个变量(或表达式)，在程序合适的位置设置断点，这样可以使程序停下来看一看这个变量有没有按照我的设想在变化。
下面我举一个简单的例子，先看源代码：sub test()for i=2 to 4 step 0.6next iend sub这是一个非常简单的循环，每一次循环i便会增加0.6，当循环3次后i值就变为4.4，但问题是每一次循环时i值变为多少？第一步：在菜单中选“调试”—“添加监视”，在表达试中填“i”，点击确定，这时你会看到临视窗口中会多一行。
第二步：把光标移到代码窗口中的“next i”行，按一下“F9”，于是每当程序运行到这里时就会暂停了。
好，一切就绪，请按F5执行程序，在监视窗口中C值立刻变为2，再按F5继续，C值为2.6，再按几次F5，直到程序结束，这样我们就成功监视了C值的变化。
第三步：在next i行再按一次F9，清除断点。
监视的表达式的右键菜单选择“删除监视”。
另外，还可以用“逐语句”、“逐过程”、“运行到光标处”等方法进行调试，这些都在调试菜单中，操作比较简单，请读者自行领悟。
CAD VBA代码
一、基本操作 (1)1、块操作 (1)1.1、定义块方法： (1)1.2、把选择集加入块中的方法 (1)1.3、插入块方法： (1)1.4、画块属性方法 (1)1.5、编程思路： (1)2、画直线 (单段线) (3)3、画多段线 (4)3.1、修改出线点的位置 (4)4、画圆 (4)5、获取鼠标指定的坐标点 (4)6、旋转 (4)7.插入文字（单选） (5)（1）、左边对齐： (5)（2）、中间对齐： (5)（3）、右边对齐 (5)8.插入文字（多行） (5)9、画圆弧 (6)10、画图椭圆 (6)11、CAD打开读取数据 (6)12、绘制圆弧 (6)二、CAD VBA程序答 (7)1. VBA写的宏，可否编译成象ARX一样的程序，经加载后，在命令行打入命令后就可运行 (7)2. VB中可以生成可执行文件，而在VBA中却不行 (7)5.有时文字是从别的图中复制-粘贴的,如果不打破的话,能否直接得到文字内容. (8)GetSubEntity 方法 (8)6. 想必河伯对Excel/ActiveX有研究, 能否请教如何获得Excel文件最后一行的信息? .8可以用CurrentRegion属性计算最后一行 (8)7. 如何调用vba命令对多义线进行fit(拟合)处理 (9)8. 块属性值编辑 (9)9.如何用程序控制对象捕捉 (10)10. 如何从VBA到VB？ (10)11.IntersectWith 方法 (10)12.绘制多边形并显示多边形顶点坐标 (10)13.Private Sub AcadDocument_BeginDoubleClick(ByVal pPoint As Variant) (11)14. 现有Handpoint = acadApp.ActiveDocument.Utility.GetPoint(, "请输入套料的插入点") (12)希望用户在捕捉点或输入点坐标动作时，如何避免用户因其他操作如缩放、PAN引起的系统报错 (12)15.在VBA中如何传送一个参数给Vlisp? (12)17.我想知道vb中的那个函数或者对象的方法可以代替在cad中按esc键取消命令 (12)18点击菜单项就在该菜单上打对号是怎么实现的? (13)20请问版主，如何实时获得当前光标的X，y，z坐标值，如同状态栏上显示坐标值13 21可以设置图块中的块属性值，如内 (13)22我的选择集中有Block和PLine,我想能使用该函数 (14)23我的机器里装有cad14和cad2000,用vb写了一个程序调用cad,如何让程序每次都调用cad2000呢? (14)24我只是想判断一下 (14)25SendCommand "_line" 没有返回值,怎么知道是否添加了line (15)26为什么修改文字的对方正式后辩证文字会移回到零点？ (15)27删除块前，应先删除块的引用，怎样查找块的引用？（VBA） (15)28使用ADO的方法如何存取ACCESS数据库? (15)30如何将类似".5"数值改为"0.5"显示 (16)31请问，如何将图上所有的数字（成千上万个数值）减去同一个常数？ (17)34 把选择的对象放大几倍，VBA怎么实现？ (20)35怎样提取图形的视图左下角、右上角和图形左下角，右上角的坐标？ (20)1. 怎么查找某一个group是否存在？- (21)3. 在编程中，我遇到以下问题： (21)5. Sheets("检测报告").Select (22)6. 请问如何让form.hide后form.show时能保持form先前移动后的位置？ (22)9怎样计算一个多边形的中心点? (23)10如何返回在命令行中输入的字符,是指在没有按下回车和空格下 (24)11当我插入块时，鼠标的click_point为两个图块的公共插入点，即同时插入两个块 24 12如何把168.235642度分解成度，分，秒？我没有办法判别小数点？ (24)13. 请问在VBA中怎么使一个选择集只选中模型空间中可见图元？ (25)14. windows安装了几个打印机，如何用vb指定打印机。
CADvba开发手册
VBA开发人员手册姓名：高化奎深圳爱华勘测工程有限公司第一章：VBA入门本章将为你介绍AutoCADVBA工程及VBA交互开发环境(VBAIDE)。
尽管大部分VBA环境在行为上都是相似的，但AutoCADVBAIDE还是有些独有的特性。
在AutoCAD中还有些相关的命令可以用于装载工程、运行工程，或打开VBAIDE环境。
本章将概要介绍VBA工程、VBA命令和VBAIDE的使用。
本章具体内容如下：了解嵌入和全局VBA工程、用VBA管理器组织工程、处理宏、用VBAIDE编辑工程、更多的信息、回顾AutoCADVBA工程术语、回顾AutoCADVBA命令第一节：了解嵌入和全局VBA工程AutoCADVBA工程是代码模块、类模块和窗体的集合，它们组合起来以执行给予的功能。
工程可保存在AutoCAD图形中，或作为独立的文件保存。
嵌入工程是保存在AutoCAD图形中。
当包含有这些工程的图形中AutoCAD打开时，他们可以自动地装载，这种方法可以很方便地分发工程给用户。
嵌入工程也有它的极限，它不能打开或关闭AutoCAD图形，那是由于他们的函数只存在于工程所在的文档中。
使用嵌入工程不需要在运行程序之前查找并装载工程文件。
举个含有嵌入工程的图形的例子，当图形打开时，一个时间日志被触发。
通过这样一个宏的应用可以登记并记录用户在该图形上所花费的时间。
这时用户不必去记住在打开图形之前装载工程，这就是自动操作的一个很好的例子。
全局工程保存在独立的文件中，它更加通用，因为他们能在AutoCAD图形中运行，也能打开、关闭AutoCAD图形，但它在图形打开时不能自动装载。
用户必须知道他们所需要的宏包含在哪个工程文件中。
然而，全局工程非常容易与其它使用者共享，它可以将通用的宏做为很好的库而存在。
举个例子，你保存在一个工程文件中的宏是有关多个图形的材料清单。
这个宏可以在工作周期的末期由管理员运行，这样就可以收集到所有图形的信息。
AutoCAD_VBA二次开发初级教程(选做)
AutoCAD VBA二次开发初级教程第一课：入门1.什么是Autocad VBA？VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
2、VBA有多难？相信大家都知道Basic是的含义。
应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。
3、怎样学习VBA？介绍大家一个学习公式：信心+恒心=开心。
仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。
本教程将陆续发布在CAD 世界论坛上，您不需要付费就可以学习。
本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。
我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
4、现在我们开始编写第一个程序：画一百个同心圆第一步：复制下面的红色代码第二步：在模型空间按快捷键Alt+F8，出现宏窗口第三步：在宏名称中填写C100，点“创建”、“确定”第四步：在Sub c100()和End Sub之间粘贴代码第五步：回到模型空间，再次按Alt+F8，点击“运行”Sub c100()Dim cc(0 To 2) As Double '声明坐标变量cc(0) = 1000 '定义圆心座标cc(1) = 1000cc(2) = 0For i = 1 To 1000 Step 10 '开始循环Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆Next iEnd Sub也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。
CADVBA初级教程(全)
第一课：入门1.为什么要写这个教程市面上ACAD VBA 的书不多，它的帮助是英文版的，很多人看不懂。
其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
2.什么是Autocad VBA？VBA 是Visual Basic for Applications 的英文缩写，它是一个功能强大的开发工具，学好VBA 可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD 命令不可能完成的，只要学好VBA 就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
3、VBA 有多难？相信大家都知道Basic 是的含义。
应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。
4、怎样学习VBA？介绍大家一个学习公式：信心+恒心=开心。
仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。
本教程将陆续发布在CAD 世界论坛上，您不需要付费就可以学习。
本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。
我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。
5、现在我们开始编写第一个程序：画一百个同心圆第一步：复制下面的红色代码第二步：在模型空间按快捷键Alt+F8，出现宏窗口第三步：在宏名称中填写C100，点“创建”、“确定”第四步：在Sub c100()和End Sub 之间粘贴代码第五步：回到模型空间，再次按Alt+F8，点击“运行”Sub c100()Dim cc(0 To 2) As Double '声明坐标变量cc(0) = 1000 '定义圆心座标cc(1) = 1000cc(2) = 0For i = 1 To 1000 Step 10 '开始循环Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆Next iEnd Sub也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。
AutoCAD-VBA简介及自动化介绍
AutoCAD VBA一、A u t o C A D V B A简介•VBA（Visual Basic for Application）VBA是AutoCAD的一种开发工具，具有强大的功能。
Microsoft VBA是一种面向对象的编程环境，它与VB一样具有很强的开发功能。
VBA与VB之间的区别就是VBA AutoCAD在同一处理空间运行，为AutoCAD提供智能和快速的编程环境。
VBA功能：创建对话框和其它界面；●创建工具栏；●建立模块级宏指令；●提供建立类模块的功能；●具有完善的数据访问和管理能力；(ADO、DAO、RDO，C/S)●能够使用Win32API提供的功能，建立应用程序与操作系统之间的通信；在AutoCAD中使用VBA的好处Visual Basic编程环境易学易用；●VBA作为AutoCAD的一个过程运行，这使程序执行速度变得非常快；●对话框结构快速有效，允许开发者在设计时启动应用程序并能得到快速反馈；（易于代码纠错和维护）●对象可以独立出来，也可以嵌入AutoCAD图形。
灵活性很强。
二、理解类和对象在AutoCAD VBA界面中有许多不同类型的对象。
例如:●图形对象，如线、弧、文本和标注都是对象；●样式设置，如线型和标注样式均为对象；●组织结构，如图层、组合和图块也是对象；●图形显示，如视图和视口都是对象；●甚至图形和AutoCAD应用程序本身也是对象。
对象是通过分层方式来组织的，应用程序对象为根对象。
这种分层结构的视图被归结为对象模型。
对象模型提供了你访问下一层对象的途径。
集合对象是预先定义的对象，它包含所有相似对象的实例(即这些对象的父对象)。
集合对象有以下的对象：文档(Documents)集合包含所有在当前AutoCAD进程打开的文档。
模型空间(ModelSpace)集合包含在模型空间中的所有图形对象(图元)。
图纸空间(PaperSpace)集合包含在活动图纸空间布局中的所有图形对象(图元)。
CADVBA初级教程(全)
第一课：入门1.为什么要写这个教程市面上ACAD VBA 的书不多，它的帮助是英文版的，很多人看不懂。
其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。
2.什么是Autocad VBA?VBA 是Visual Basic for Applications 的英文缩写，它是一个功能强大的开发工具,学好VBA 可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD 命令不可能完成的，只要学好VBA 就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。
3、VBA 有多难？相信大家都知道Basic 是的含义.应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正.4、怎样学习VBA？介绍大家一个学习公式：信心+恒心=开心。
仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。
本教程将陆续发布在CAD 世界论坛上,您不需要付费就可以学习。
本作者在此郑重承诺：关于本教程中有任何疑问,可以跟贴提问,只要有时间，本人一定会耐心解答.我不会发到任何人的邮箱中，您自己在论坛上找就可以了,请不要再向我索要这份教程。
5、现在我们开始编写第一个程序：画一百个同心圆第一步：复制下面的红色代码第二步:在模型空间按快捷键Alt+F8，出现宏窗口第三步:在宏名称中填写C100，点“创建”、“确定”第四步：在Sub c100(）和End Sub 之间粘贴代码第五步：回到模型空间,再次按Alt+F8，点击“运行"Sub c100（）Dim cc（0 To 2) As Double '声明坐标变量cc(0) = 1000 ’定义圆心座标cc（1) = 1000cc(2） = 0For i = 1 To 1000 Step 10 ’开始循环Call ThisDrawing.ModelSpace.AddCircle(cc, i ＊ 10） '画圆Next iEnd Sub也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了,祝您成功。
VBA结合cad开发的介绍
VBA的概念、功能和基本界面37.2.1 VBA的概念与作用VBA（Visual Basic for Application）是一种完全面向对象体系结构的编程语言，由于其在开发方面的易用性和具有强大的功能，因此许多应用程序均嵌入该语言作为开发工具。
Autodesk公司也在AutoCAD R14.01版本开始内置了VBA开发工具，同时提供了适用于VBA 开发的ActiveX Automation对象模型。
在AutoCAD 2002版本中内置的VBA是基于Visual Basic 6.0版本，其版本信息如图37-3所示。
VBA具有很强的开发能力，其主要功能包括：(1) 创建对话框及其它界面。
(2) 创建工具栏。
(3) 建立模块级宏指令。
(4) 提供建立类模块的功能。
(5) 具有完善的数据访问与管理能力，可通过DAO（数据访问对象）对Access数据库或其它外部数据库进行访问和管理。
(6) 能够使用SQL语句检索数据，与RDO（远程数据对象）结合起来，可建立C/S（客户机/服务机）级的数据通信。
(7) 能够使用Win32 API提供的功能，建立应用程序与操作系统间的通信。
从功能上来说，VBA与VB几乎完全一样，或者说VBA是VB的一个子集。
但它们之间更本质的区别在于VBA没有自己独立的工作环境，而必须依附于主应用程序；而VB则不依附于任何其它的应用程序，具有完全独立的工作环境和编译、连接系统。
由于VBA依附于主应用程序，因此它与主应用程序之间的通信简单而富有效率，其代码完全是在进程内执行的。
VBA的代码在AutoCAD中仍以解释的方式执行，但由于它与AutoCAD 共享内存空间，因此执行速度比ADS程序还要快。
37.2.2 VBA的启动和界面由于VBA集成在AutoCAD系统内部，因此用户必须先启动AutoCAD，然后才能进入VBA IDE 环境。
启动VBA的方式为：菜单：【Tools（工具）】→【Macor（宏）】→【Visual Basic Editor（VB编辑器）】命令行：vbaide启动VB编辑器后，其常用界面如图37-4所示。
利用AutoCAD VBA建立自动编号程序及其在岩土工程领域中的应用
利用AutoCAD VBA建立自动编号程序及其在岩土工程领域
中的应用
张永闯;黄英娣
【期刊名称】《城市建设》
【年(卷),期】2010(000)012
【摘要】利用VBA在CAD中建立自动编号程序,在CAD图纸中对各种岩土工程领域的桩位、钻孔、钎探点、物探点、测量点等进行编号,在编号的同时可列出所以点位的坐标,并形成全站仪仪器格式的文件,可直接传入仪器中使用,提高了点位编号、坐标捕捉等工作的速度及准确度,应用范围较广.
【总页数】2页(P390-391)
【作者】张永闯;黄英娣
【作者单位】桂林理工大学土木与建筑工程学院,广西桂林,541004;桂林理工大学土木与建筑工程学院,广西桂林,541004
【正文语种】中文
【相关文献】
1.利用AutoCADVBA建立自动编号程序及其在岩土工程领域中的应用 [J], 张永闯;黄英娣
2.利用VBA建立AutoCad2000与Excel通信 [J], 许春培
3.AutoCAD VBA办公自动化程序应用实例——排水流向标注程序 [J], 赵志清
4.利用VBA建立AutoCAD与Excel通信 [J], 许春培
5.利用AutoCAD VBA编写自动标高标注程序 [J], 易宁; 昌志敏; 陈晓峰
因版权原因，仅展示原文概要，查看原文内容请购买。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
这个和我之前传的算点教程是一起的。
我用的是CAD2008，CAD2012。
这个程序也是用VBA编写的。
只做参考：Private Sub CommandButton1_Click()'''===============================加字程序===================Static Textstr As StringStatic Inserp(0 To 2) As DoubleStatic Textheight As DoubleStatic a, b, c As StringStatic i, j, k As IntegerStatic x As StringStatic ExcelApp As New Excel.ApplicationStatic lay0 As AcadLayerStatic lay1 As AcadLayerfindlay = 0For Each lay0 In yersIf = "监控编号" Thenfindlay = 1msgstr = + "已经存在" + vbCrLfmsgstr = msgstr + "图层状态:" + IIf(yerOn = True, "打开", "关闭") + vbCrLfmsgstr = msgstr + "图层:" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf msgstr = msgstr + "图层:" + IIf(lay0.Lock = True, "已经", "没有") + "冻结" + vbCrLfmsgstr = msgstr + "图层颜色号:" + CStr(lay0.color) + vbCrLfmsgstr = msgstr + "图层线型:" + lay0.Linetype + vbCrLfmsgstr = msgstr + "图层线宽:" + CStr(lay0.Lineweight) + vbCrLfmsgstr = msgstr + "打印开关:" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf msgstr = msgstr + "是否设置为当前图层?"If MsgBox(msgstgr, 1) = 1 ThenIf Not yerOn Then yerOn = TrueThisDrawing.ActiveLayer = lay0End IfExit ForEnd IfNext lay0If findlay = 0 ThenSet lay1 = yers.Add("监控编号")lay1.color = 1ThisDrawing.ActiveLayer = lay1End Ifa = InputBox("请输入数据的路径及文件名") + ".xls"ExcelApp.Workbooks.Open a, , ReadOnlyDim js, jx As Integerjs = 0For jx = 1 To 1000If Range("A" & jx).Value <> "" Thenjs = js + 1End IfNext jxj = jsStatic O As IntegerO = 0For i = 1 To j + 1If Range("B" & i + 1).Value = "3.6mm半球" Or Range("B" & i + 1).Value = "3.6mm半球(W)" Or _ Range("B" & i + 1).Value = "6mm半球(W)" Or Range("B" & i + 1).Value = "6mm半球" Or _ Range("B" & i + 1).Value = "2.8mm半球(W)" Or Range("B" & i + 1).Value = "2.8mm半球" Or _ Range("B" & i + 1).Value = "枪机" Or Range("B" & i + 1).Value = "一体化球机" Or _Range("B" & i + 1).Value = "针孔" Or Range("B" & i + 1).Value = "室外罩枪机" Or _Range("B" & i + 1).Value = "室外云台" Or Range("B" & i + 1).Value = "室内罩枪机" ThenO = O + 1End Ifx = OIf O < 10 Thenx = "S-00" + xElseIf O >= 10 And O < 100 Thenx = "S-0" + xElsex = "S-" + xEnd IfIf Range("B" & i + 1).Value = "3.6mm半球" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & i + 1).Value = "3.6mm半球(W)" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & i + 1).Value = "6mm半球(W)" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "6mm半球" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "2.8mm半球(W)" Then Textstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "2.8mm半球" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "枪机" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "一体化球机" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i + 1).Value = "针孔" ThenInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & i + 1).Value = "室外罩枪机" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & i + 1).Value = "室外云台" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & i + 1).Value = "室内罩枪机" ThenTextstr = xInserp(0) = Range("k" & i + 1).ValueInserp(1) = Range("l" & i + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kEnd IfNext ifindlay = 0For Each lay0 In yersIf = "报警编号" Thenfindlay = 1msgstr = + "已经存在" + vbCrLfmsgstr = msgstr + "图层状态:" + IIf(yerOn = True, "打开", "关闭") + vbCrLf msgstr = msgstr + "图层:" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf msgstr = msgstr + "图层:" + IIf(lay0.Lock = True, "已经", "没有") + "冻结" + vbCrLf msgstr = msgstr + "图层颜色号:" + CStr(lay0.color) + vbCrLfmsgstr = msgstr + "图层线型:" + lay0.Linetype + vbCrLfmsgstr = msgstr + "图层线宽:" + CStr(lay0.Lineweight) + vbCrLfmsgstr = msgstr + "打印开关:" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf msgstr = msgstr + "是否设置为当前图层?"If MsgBox(msgstgr, 1) = 1 ThenIf Not yerOn Then yerOn = TrueThisDrawing.ActiveLayer = lay0End IfExit ForEnd IfNext lay0If findlay = 0 ThenSet lay1 = yers.Add("报警编号")lay1.color = 1ThisDrawing.ActiveLayer = lay1End IfStatic I1 As IntegerStatic x1 As StringStatic O1 As IntegerO1 = 0For I1 = 1 To j + 1If Range("B" & I1 + 1).Value = "门磁" _Or Range("B" & I1 + 1).Value = "幕帘探测器" _Or Range("B" & I1 + 1).Value = "卷帘门磁" _Or Range("B" & I1 + 1).Value = "紧急按钮" _Or Range("B" & I1 + 1).Value = "三鉴" _Or Range("B" & I1 + 1).Value = "收银线门磁" _Or Range("B" & I1 + 1).Value = "铁门磁" _Or Range("B" & I1 + 1).Value = "传感器" _Or Range("B" & I1 + 1).Value = "自清器" ThenO1 = O1 + 1End Ifx1 = O1If O1 < 10 Thenx1 = "B-00" + x1ElseIf O1 >= 10 And O1 < 100 Thenx1 = "B-0" + x1Elsex1 = "B-" + x1End IfIf Range("B" & I1 + 1).Value = "门磁" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "幕帘探测器" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "卷帘门磁" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "紧急按钮" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "三鉴" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "收银线门磁" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & I1 + 1).Value = "铁门磁" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & I1 + 1).Value = "传感器" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kElseIf Range("B" & I1 + 1).Value = "自清器" ThenTextstr = x1Inserp(0) = Range("k" & I1 + 1).Value + 400Inserp(1) = Range("l" & I1 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight)Next kEnd IfNext I1findlay = 0For Each lay0 In yersIf = "广播编号" Thenfindlay = 1msgstr = + "已经存在" + vbCrLfmsgstr = msgstr + "图层状态:" + IIf(yerOn = True, "打开", "关闭") + vbCrLfmsgstr = msgstr + "图层:" + IIf(lay0.Freeze = True, "已经", "没有") + "冻结" + vbCrLf msgstr = msgstr + "图层:" + IIf(lay0.Lock = True, "已经", "没有") + "冻结" + vbCrLfmsgstr = msgstr + "图层颜色号:" + CStr(lay0.color) + vbCrLfmsgstr = msgstr + "图层线型:" + lay0.Linetype + vbCrLfmsgstr = msgstr + "图层线宽:" + CStr(lay0.Lineweight) + vbCrLfmsgstr = msgstr + "打印开关:" + IIf(lay0.Plottable = False, "关闭", "打开") + vbCrLf + vbCrLf msgstr = msgstr + "是否设置为当前图层?"If MsgBox(msgstgr, 1) = 1 ThenIf Not yerOn Then yerOn = TrueThisDrawing.ActiveLayer = lay0End IfExit ForEnd IfNext lay0If findlay = 0 ThenSet lay1 = yers.Add("广播编号")lay1.color = 1ThisDrawing.ActiveLayer = lay1End IfStatic x2 As StringStatic O2 As IntegerO2 = 0For i2 = 1 To j + 1If Range("B" & i2 + 1).Value = "吸顶扬声器" _Or Range("B" & i2 + 1).Value = "室外扬声器" _Or Range("B" & i2 + 1).Value = "30W室内音柱" _Or Range("B" & i2 + 1).Value = "10W壁挂音柱" ThenO2 = O2 + 1End Ifx2 = O2If O2 < 10 Thenx2 = "G-00" + x2ElseIf O2 >= 10 And O2 < 100 Thenx2 = "G-0" + x2Elsex2 = "G-" + x2End IfIf Range("B" & i2 + 1).Value = "吸顶扬声器" ThenTextstr = x2Inserp(0) = Range("k" & i2 + 1).Value + 400Inserp(1) = Range("l" & i2 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i2 + 1).Value = "室外扬声器" ThenTextstr = x2Inserp(0) = Range("k" & i2 + 1).Value + 400Inserp(1) = Range("l" & i2 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i2 + 1).Value = "30W室内音柱" Then Textstr = x2Inserp(0) = Range("k" & i2 + 1).Value + 400Inserp(1) = Range("l" & i2 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kElseIf Range("B" & i2 + 1).Value = "10W壁挂音柱" Then Textstr = x2Inserp(0) = Range("k" & i2 + 1).Value + 400Inserp(1) = Range("l" & i2 + 1).ValueTextheight = 240For k = 1 To 1Call ThisDrawing.ModelSpace.AddText(Textstr, Inserp, Textheight) Next kEnd IfNext i2ExcelApp.Workbooks.CloseExcelApp.QuitThisDrawing.Application.UpdateSet ExcelApp = NothingEnd Sub。