AutoCAD-VBA简介及自动化介绍.doc

AutoCAD VBA一、AutoCAD VBA简介•VBA〔Visual Basic for Application〕VBA是AutoCAD的一种开发工具，具有强大的功能Microsoft VBA是一种面向对象的编程环境，它与VB一样具有很强的开发功能VBA与VB之间的区别就是VBA AutoCAD在同一处理空间运行，为AutoCAD提供智能和快速的编程环境VBA功能：l 创立对话框和其它界面；l 创立工具栏；l 建立模块级宏指令；l 提供建立类模块的功能；l 具有完善的数据访问和管理能力；(ADO、DAO、RDO，C/S)l 能够使用Win32API提供的功能，建立应用程序与操作系统之间的通信；在AutoCAD中使用VBA的好处l Visual Basic编程环境易学易用；l VBA作为AutoCAD的一个过程运行，这使程序执行速度变得非常快；l 对话框结构快速有效，允许开发者在设计时启动应用程序并能得到快速反应；〔易于代码纠错和维护〕l 对象可以独立出来，也可以嵌入AutoCAD图形灵活性很强二、理解类和对象在AutoCAD VBA界面中有许多不同类型的对象例如:l 图形对象，如线、弧、文本和标注都是对象；l 样式设置，如线型和标注样式均为对象；l 组织结构，如图层、组合和图块也是对象；l 图形显示，如视图和视口都是对象；l 甚至图形和AutoCAD应用程序本身也是对象。

对象是通过分层方式来组织的，应用程序对象为根对象这种分层结构的视图被归结为对象模型对象模型提供了你访问下一层对象的途径集合对象是预先定义的对象，它包含所有相似对象的实例(即这些对象的父对象)集合对象有以下的对象：文档(Documents)集合包含所有在当前AutoCAD进程翻开的文档模型空间(ModelSpace)集合包含在模型空间中的所有图形对象(图元)图纸空间(PaperSpace)集合包含在活动图纸空间布局中的所有图形对象(图元)图块(Block)对象包含在指定图块定义中的所有图元图块(Blocks)集合包含在图形中的所有图块字典(Dictionaries)集合包含在图形中的所有字典标注样式(DimStyles)集合包含在图形中的所有标注样式组合(Groups)集合包含在图形中的所有组合超级(Hyperlinks)集合包含提供图元的所有超级图层(Layers)集合包含在图形中的所有图层布局(Layouts)集合包含在图形中的所有布局线型(Linetypes)集合包含在图形中的所有线型菜单条(MenuBar)集合包含当前显示于AutoCAD的所有菜单菜单组(MenuGroups)集合包含当前装载到AutoCAD中的所有菜单和工具栏。

注册应用程序(RegisteredApplications)集合包含在图形中的所有注册的应用程序选择集(SelectionSets)集合包含在图形中所有的选择集字型(TextStyles)集合包含在图形中所有的文字样式UCSs 集合包含在图形中所有的用户坐标系统(UCS)视图(Views)集合包含在图形中所有的视图视口(Viewports)集合包含在图形中所有的视口三、理解对象的属性和方法每一对象都关联着属性和方法属性描述着单个对象的外观，而方法是一种可在单个对象上执行的行为当对象创立后，你就可通过属性和方法查询和编辑对象例如，一个圆对象有圆心属性该属性以三维世界坐标系统的坐标描述了圆的圆心更改圆的圆心，你只要简单地将该属性设定为新的坐标圆对象也有称为偏移(Offset)的方法该方法可在相对于现存圆的指定偏移距离创立一个新的对象关于圆对象所有属性和方法的列表，请参考AutoCAD ActiveX和VBA参考中的圆对象四、开发实例1、程序和文档窗口设置'''*****************************************************************************Sub MyWindow() MsgBox ThisDrawing.WindowTitle '= "杨彪绘图01" ThisDrawing.WindowState = acMin 'acMax 'acNormEnd SubSub SetMyAcadTitle() Dim hw& hw = GetParent(GetParent(ThisDrawing.hwnd)) SetWindowText hw, "杨彪地质编录出图子系统" Call InitialDZBL '初始化 ThisDrawing.WindowState = acMaxEnd SubSub SetMyAcadWindow() ThisDrawing.Application.WindowState = acNorm ThisDrawing.Application.WindowLeft = 100 ThisDrawing.Application.WindowLeft = 100 ThisDrawing.Application.Width = 600 ThisDrawing.Application.Height = 600End Sub2、视图'''**************************************************************************Sub MyZoomView1() ZoomAllEnd SubSub MyZoomView2() Dim VPn1 As Variant, VPn2 As Variant VPn1 = ThisDrawing.Utility.getpoint(, " 缩放窗口左下点：") VPn2 = ThisDrawing.Utility.getpoint(, " 缩放窗口右上点：") ThisDrawing.Application.ZoomWindow VPn1, VPn2End Sub3、二维图形绘制‘addlineSub Myaddline() Dim ln As AcadLine Dim startPt(2) As Double, EndPt(2) As Double startPt(0) = 0 startPt(1) = 0 startPt(0) = 100 startPt(1) = 50 Set ln = ThisDrawing.ModelSpace.AddLine(startPt(), EndPt()) ln.color = acRed ZoomAllEnd Sub‘LightWeightPolylineSub MyLightWeightPolyline () Dim MyPln As AcadLWPolyline Dim Pnts(9) As Double For I = 0 To 9 Pnts(I) = Rnd * 100 Next' Pnts(0) = PntMin(0): Pnts(1) = PntMin(1)' Pnts(2) = PntMin(0) + DWidth: Pnts(3) = PntMin(1)' Pnts(4) = PntMin(0) + DWidth: Pnts(5) = PntMin(1) + DHeight' Pnts(6) = PntMin(0): Pnts(7) = PntMin(1) + DHeight' Pnts(8) = PntMin(0): Pnts(9) = PntMin(1) Set MyPln = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pnts) Dim n As Integer n = UBound(Pnts) For K = 0 To (n / 2 - 1) '宽度设定 MyPln.SetWidth K, K / 5, Rnd * 10 Next MyPln.color = acYellow ZoomAllEnd Sub‘PolylineSub MyPolyline() Dim MyPln As AcadPolyline Dim Pnts(8) As Double '''必须是3*N的数组 For I = 0 To 8 Pnts(I) = Rnd * 100 Next Set MyPln = ThisDrawing.ModelSpace.AddPolyline(Pnts) Dim n As Integer n = UBound(Pnts) For K = 0 To (n / 3 - 1) '宽度设定 MyPln.SetWidth K, K / 5, Rnd * 10 Next MyPln.color = acYellow ZoomAllEnd Sub‘LightCircle and HatchSub MyCircle() Dim Cir(0) As AcadCircle VPn1 = ThisDrawing.Utility.getpoint(, " 输入插入点：") Set Cir(0) = ThisDrawing.ModelSpace.AddCircle(VPn1, 10#) Set MyHatchObj = ThisDrawing.ModelSpace.AddHatch(0, "Solid", True) MyHatchObj.AppendOuterLoop (Cir) MyHatchObj.color = 1 MyHatchObj.EvaluateEnd SubSub Mytext() Dim MyTxt As AcadText Dim StrTxt As String Dim VPnts(2) As Double StrTxt = "HoHai UniverSity 河海大学土木工程学院测绘工程系" Set MyTxt = ThisDrawing.ModelSpace.AddText(StrTxt, VPnts, 100) MyTxt.color = acRed ZoomAllEnd SubSub MyPoint() Dim Pnts(0 To 2) As Double Dim I As Integer, J As Integer Dim MyPoint As AcadPoint Pnts(I) = 50 Pnts(I) = 60 Set MyPoint = ThisDrawing.ModelSpace.AddPoint(Pnts) ZoomAllEnd Sub4、图层Sub GetlayerName()。