《AutoCAD VBA简介及自动化介绍》由会员分享，可在线阅读，更多相关《AutoCAD VBA简介及自动化介绍（19页珍藏版）》请在金锄头文库上搜索。
1、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提供的功能，建立应用程序与操作系统之
2、间的通信；在AutoCAD中使用VBA的好处l Visual Basic编程环境易学易用；l VBA作为AutoCAD的一个过程运行，这使程序执行速度变得非常快；l 对话框结构快速有效，允许开发者在设计时启动应用程序并能得到快速反馈；（易于代码纠错和维护）l 对象可以独立出来，也可以嵌入AutoCAD图形。灵活性很强。二、理解类和对象在AutoCAD VBA界面中有许多不同类型的对象。例如:l 图形对象，如线、弧、文本和标注都是对象；l 样式设置，如线型和标注样式均为对象；l 组织结构，如图层、组合和图块也是对象；l 图形显示，如视图和视口都是对象；l 甚至图形和AutoCAD应用程序本身也是
3、对象。对象是通过分层方式来组织的，应用程序对象为根对象。这种分层结构的视图被归结为对象模型。对象模型提供了你访问下一层对象的途径。集合对象是预先定义的对象，它包含所有相似对象的实例(即这些对象的父对象)。集合对象有以下的对象：文档(Documents)集合包含所有在当前AutoCAD进程打开的文档。模型空间(ModelSpace)集合包含在模型空间中的所有图形对象(图元)。图纸空间(PaperSpace)集合包含在活动图纸空间布局中的所有图形对象(图元)。图块(Block)对象包含在指定图块定义中的所有图元。图块(Blocks)集合包含在图形中的所有图块。字典(Dictionaries)集合包
4、含在图形中的所有字典。标注样式(DimStyles)集合包含在图形中的所有标注样式。组合(Groups)集合包含在图形中的所有组合。超级链接(Hyperlinks)集合包含提供图元的所有超级链接。图层(Layers)集合包含在图形中的所有图层。布局(Layouts)集合包含在图形中的所有布局。线型(Linetypes)集合包含在图形中的所有线型。菜单条(MenuBar)集合包含当前显示于AutoCAD的所有菜单。菜单组(MenuGroups)集合包含当前装载到AutoCAD中的所有菜单和工具栏。注册应用程序(RegisteredApplications)集合包含在图形中的所有注册的应用程序。选
5、择集(SelectionSets)集合包含在图形中所有的选择集。字型(TextStyles)集合包含在图形中所有的文字样式。UCSs 集合包含在图形中所有的用户坐标系统(UCS)。视图(Views)集合包含在图形中所有的视图。视口(Viewports)集合包含在图形中所有的视口。三、理解对象的属性和方法每一对象都关联着属性和方法。属性描述着单个对象的外观，而方法是一种可在单个对象上执行的行为。当对象创建后，你就可通过属性和方法查询和编辑对象。 例如，一个圆对象有圆心属性。该属性以三维世界坐标系统的坐标描述了圆的圆心。更改圆的圆心，你只要简单地将该属性设定为新的坐标。圆对象也有称为偏移(Offs
6、et)的方法。该方法可在相对于现存圆的指定偏移距离创建一个新的对象。关于圆对象所有属性和方法的列表，请参考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, 杨彪地质编录
7、出图子系统 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、视图*Su
8、b MyZoomView1() ThisDrawing.Application.ZoomExtents 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()
9、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 SubLightWeightPolylineSub MyLightWeightPolyline () Dim MyPln As AcadLWPolyline Dim Pnt
10、s(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) Se
11、t 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 SubPolylineSub MyPolyline() Dim MyPln As AcadPolyline Dim Pnts(8) As Double 必须是3*N的数组 For I = 0 To 8
12、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 SubLightCircle and HatchSub MyCircle() Dim Cir(0) As AcadCircle VPn1 = ThisDrawing.Ut
13、ility.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) =
