资源预览内容
第1页 / 共19页
第2页 / 共19页
第3页 / 共19页
第4页 / 共19页
第5页 / 共19页
第6页 / 共19页
第7页 / 共19页
第8页 / 共19页
第9页 / 共19页
第10页 / 共19页
亲,该文档总共19页,到这儿已超出免费预览范围,如果喜欢就下载吧!
资源描述
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() 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() 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 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 SubPolylineSub 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 SubLightCircle 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) =
网站客服QQ:2055934822
金锄头文库版权所有
经营许可证:蜀ICP备13022795号 | 川公网安备 51140202000112号