CAD应用二次开发VB和VBA开发CAD的知识.doc

1、如何在VB中连接AutoCAD。 启动VB，引用AutoCAD类型库。操作步骤：从“工程”菜单中选择“引用”选项，启动“引用”对话框。在“引用”对话框中，选择AutoCAD类型库，然后单击“确定”。 定义模块级变量AutoCAD应用程序(acadApp)和当前的文档(acadDoc)。 如果AutoCAD正在运行，使用GetObject函数将检索AutoCADApplication对象。如果AutoCAD没有运行，使用CreateObject函数试图创建一个AutoCADApplication对象。如果创建成功，会启动AutoCAD；如果失败，则会发生错误。 同时运行多个AutoCAD任务时，GetObject函数会返回Windows运行对象表中的第一个AutoCAD实例。 要显示AutoCAD图形窗口，需要将AutoCAD应用程序的Visible特性设置为TRUE。 使用acadDoc变量引用当前的AutoCAD图形。 示例： DimacadAppAsAcadApplication DimacadDocasAcadDocument SubConnectToAcad() OnErrorResumeNext SetacadApp=GetObject(,AutoCAD.Application) IfErrThen Err.Clear SetacadApp=CreateObject(AutoCAD.Application) IfErrThenEnd EndIf acadApp.Visible=True SetacadDoc=acadApp.ActiveDocument EndSub 2、如何使VB开发的程序不依赖于AutoCAD的版本。 启动VB，定义模块级变量AutoCAD应用程序(acadApp)和当前的文档(acadDoc)。 如果AutoCAD正在运行，使用GetObject函数将检索AutoCADApplication对象。如果AutoCAD没有运行，使用CreateObject函数试图创建一个AutoCADApplication对象。如果创建成功，会启动AutoCAD；如果失败，则会发生错误。 同时运行多个AutoCAD任务时，GetObject函数会返回Windows运行对象表中的第一个AutoCAD实例。 要显示AutoCAD图形窗口，需要将AutoCAD应用程序的Visible特性设置为TRUE。 使用acadDoc变量引用当前的AutoCAD图形。 示例： DimacadAppAsObject DimacadDocasObject SubConnectToAcad() OnErrorResumeNext SetacadApp=GetObject(,AutoCAD.Application) IfErrThen Err.Clear SetacadApp=CreateObject(AutoCAD.Application) IfErrThenEnd EndIf acadApp.Visible=True SetacadDoc=acadApp.ActiveDocument EndSub 与第一个问题相比较，可以看出，不引用具体的类型库以及使用通用的对象类型就可以达到通用性。 3、前期绑定和后期绑定 要创建一个使用前期绑定方式的对象变量，也就是说，在程序编译时就完成绑定，则对象变量在声明时应指定类ID，如：DimacadAppAsAcadApplication。 使用AsObject子句声明对象变量，可以创建一个能包含任何类型对象引用的变量。不过，该变量访问对象是后期绑定的，也就是说，绑定在程序运行时才进行，如：DimacadAppAsObject。 前期绑定的变量引用可以提供更好的性能，但该变量只能存放声明中所指定的类的引用。 而后期绑定的变量引用可以提供更好的通用性。 4、依赖于版本和独立于版本 如果CreateObject或GetObject函数使用的ProgID没有附加版本号，那么是独立于版本的，否则是依赖于版本的。例如，如果使用的是CreateObject，则CreateObject(AutoCAD.Application)是独立于版本的，而CreateObject(AutoCAD.Application.15)是依赖于版本的。 - yfy20032004-06-3019:59 5、VB代码到VBA代码的转换 在VBA的IDE环境中，使用“导入文件”将要转换的VB工程的模块、类模块以及窗体文件一一导入。接着将VB代码中所有的当前的文档(acadDoc)变量替换为ThisDrawing，而AutoCAD应用程序(acadApp)变量替换为Application。同时删除定义的AutoCAD应用程序(acadApp)和当前的文档(acadDoc)变量，删除与AutoCAD应用程序连接的代码。注意：要转换VB代码的窗体部分，则窗体必须是用UserForm创建的。 顶22006-02-28 22:37回复举报|drawing101 初级粉丝12楼 6、图形对象和非图形对象 图形对象（也称为图元、实体对象）是组成图形的可见对象（例如直线、圆、光栅图像等）。非图形对象是指属于图形的一部分但不可见的（提示性的）对象，例如Layers、Linetypes、DimStyles、SelectionSets等等。要创建这些对象，可使用Add方法。每一个对象都有用于特定目的的方法和特性，都有设置和检索扩展数据以及删除自己的方法。 7、创建图形对象 图形对象是在ModelSpace集合、PaperSpace集合或Block对象中创建的。 使用变量moSpace设置为当前模型空间。 本例使用AddLightweightPolyline方法创建一条分为两段的简单多段线，其端点坐标值分别是(2,4)、(4,2)和(6,4)。 DimmoSpaceAsAcadModelSpace SetmoSpace=acadDoc.ModelSpace SubAddLightWeightPolyline() DimplineObjAsAcadLWPolyline Dimpoints(0To5)AsDouble 定义二维多段线的点 points(0)=2:points(1)=4 points(2)=4:points(3)=2 points(4)=6:points(5)=4 在模型空间中创建一个优化多段线对象 SetplineObj=moSpace.AddLightWeightPolyline(points) EndSub - yfy20032004-06-3020:00 8、变体型变量（Variant）和数组 变体型变量是一种特殊的数据类型，可以包含任何类型的数据，固定长度的字符串数据和用户定义的类型除外。变量还可以包含特殊值Empty、Error、Nothing和NULL。可以使用VarType或TypeName函数来确定如何处理变量中的数据。 变体型变量用于和AutoCAD传递数组数据。这表示使用对象的属性和方法时，如果输入数组作为参数，那么VBA自动将数组转换为变体型变量。此外，从函数或者对象的属性返回的数组数据也将自动转换为变体型变量进行处理。 对第七个问题进行分析：points数组作为参数时，将自动转换成变体型变量，然后才进行生成多段线的操作。同时，如果返回点坐标的数组时，必须先定义一个变体型变量。 示例： DimmoSpaceAsAcadModelSpace SetmoSpace=acadDoc.ModelSpace SubAddLightWeightPolyline() DimplineObjAsAcadLWPolyline Dimpoints(0To5)AsDouble 定义二维多段线的点 points(0)=2:points(1)=4 points(2)=4:points(3)=2 points(4)=6:points(5)=4 在模型空间中创建一个优化多段线对象 SetplineObj=moSpace.AddLightWeightPolyline(points) 等效于 DimvpointsAsVariant Vpoints=points SetplineObj=moSpace.AddLightWeightPolyline(vpoints) 返回多段线的从标数组 DimvpointsAsVariant vpoints=plineObj.Coordinates 比较vpoints和points，它们的维数相同，元素个数相同，值也相同。 EndSub 9、系统变量 Document对象提供了SetVariable和GetVariable方法，分别用于设置和检索AutoCAD系统变量。例如，要将某个整数指定给MAXSORT系统变量，可设置为：acadDoc.SetVariableMAXSORT,100。 针对第七个问题，如果想让多段线的起点从上一次绘图的终点开始。那么可以检索LASTPOINT系统变量。 示例： DimmoSpaceAsAcadModelSpace SetmoSpace=acadDoc.ModelSpace SubAddLightWeightPolyline() DimplineObjAsAcadLWPolyline 返回上一次给图最后输入的点坐标 DimptasVariant Pt=acadDoc.GetVariable(“LASTPOINT”) Dimpoints(0To5)AsDouble 定义二维多段线的点 points(0)=pt(0):points(1)=pt(1) points(2)=4:points(3)=2 points(4)=6:points(5)=4 在模型空间中创建一个优化多段线对象 SetplineObj=moSpace.AddLightWeightPolyline(points) 2006-02-28 22:37回复举报|drawing101 初级粉丝13楼 EndSub 10、图形数据和属性数据 图形对象（也称为图元）是组成图形的可见对象（例如直线、圆、光栅图像等）。属性数据是保存图形对象的信息，比如圆可以代表电杆，那么圆就要保存电杆的信息如类型、地址、高度等。 11、随图形一起保存于文件的内部属性数据和保存于数据库的外部属性数据 属性数据可以保存于文件内部，比如扩展数据和扩展记录数据，它是随图形对象一起保存的，删除图形对象，将自动清除属性数据，因而管理方便。属性数据也可以保存于外部数据库，常见的有文件，如文本文件、Excel文件等，还有数据库，如Access、Oracle等，它需要人工手动进行管理，但数据的存取高效，通常是通过句柄来实现它们之间的联结。 - yfy20032004-06-3020:01 12、图形对象的句柄和ID号 图形对象的句柄在一个文档内是唯一的、递增的、永久的，保存于图形数据库，而图形对象的ID号在当前打开的应用程序的多文档内是唯一的，但是是暂时的、变化的，它不保存于图形数据库，而是每次打开时重新生成一次，因而每次打开时的值也是不一样的。 对于单文档的操作，可以使用Handle来返回图形对象的句柄，而用HandleToObject来获取图形对象。而对于多文档的操作，可以使用ObjectID来返回图形对象的ID号，而用ObjectIDToObject来获取图形对象。 13、扩展数据和扩展记录数据 可以将扩展数据（XData）和扩展记录数据（XRecordData）用作链接信息与图形中对象的方式。扩展数据和扩展记录数据的区别是：扩展数据有16K存储空间的限制，并且使用1000及以上的组码值，而扩展记录数据则没有空间和顺序的限制，并且组码在1000以下。还有一个不同之处是可以在选择集中操作扩展数据。ACAD提供了SetXData和GetXData的函数来设置和返回扩展数据，通常扩展数据需要提供一个已经注册的应用程序（RegisteredApplication）名称作为不同程序之间的数据区分。ACAD也提供了SetXRecordData和GetXRecordData的函数来设置和返回扩展记录数据，但是由于扩展记录数据是保存于扩展词典（ExtensionDictionary）中的，因而要用HasExtensionDictionary来判断是否包含扩展词典，而用GetExtensionDictionary来返回扩展词典，如不存在，它就会创建一个。再通过扩展词典的GetObject来返回扩展记录对象，AddXRecord添加一个扩展记录对象。 示例： SubExample_XData() 这个例子创建一条直线，并且添加扩展数据 创建直线 DimlineObjAsAcadLine DimstartPt(0To2)AsDouble,endPt(0To2)AsDouble startPt(0)=1#:startPt(1)=1#:startPt(2)=0# endPt(0)=5#:endPt(1)=5#:endPt(2)=0# SetlineObj=ThisDrawing.ModelSpace.AddLine(startPt,endPt) 初始化所有的扩展数据。注意第一个值必须是应用程序名称，而它的组码必须是1001。 DimDataType(0To9)AsInteger DimData(0To9)AsVariant Dimreals3(0To2)AsDouble DimworldPos(0To2)AsDouble DataType(0)=1001:Data(0)=Test_Application DataType(1)=1000:Data(1)=Thisisatestforxdata DataType(2)=1003:Data(2)=0层 DataType(3)=1040:Data(3)=1.23479137438413E+40实数 DataType(4)=1041:Data(4)=1237324938距离 DataType(5)=1070:Data(5)=3276716位整数 DataType(6)=1071:Data(6)=3276732位整数 DataType(7)=1042:Data(7)=10比例因子 reals3(0)=-2.95:reals3(1)=100:reals3(2)=-20 DataType(8)=1010:Data(8)=reals3实数 worldPos(0)=4:worldPos(1)=400.99999999:worldPos(2)=2.798989 DataType(9)=1011:Data(9)=worldPosworldspaceposition 2006-02-28 22:37回复举报|drawing101 初级粉丝14楼 在直线上附着扩展数据 lineObj.SetXDataDataType,Data 返回直线的扩展数据 DimxdataOutAsVariant DimxtypeOutAsVariant lineObj.GetXData,xtypeOut,xdataOut EndSub 示例： SubExample_XRecordData() 这个例子当扩展记录对象不存在时创建一个新的扩展记录对象，并且添加扩展记录数据。 DimTrackingDictionaryAsAcadDictionary,TrackingXRecordAsAcadXRecord DimXRecordDataTypeAsVariant,XRecordDataAsVariant DimArraySizeAsLong,iCountAsLong DimDataTypeAsInteger,DataAsString,msgAsString UniqueidentifierstodistinguishourXRecordDatafromotherXRecordData ConstTYPE_STRING=1 ConstTAG_DICTIONARY_NAME=ObjectTrackerDictionary ConstTAG_XRECORD_NAME=ObjectTrackerXRecord 连接扩展词典 OnErrorGoToCREATE SetTrackingDictionary=ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME) SetTrackingXRecord=TrackingDictionary.GetObject(TAG_XRECORD_NAME) OnErrorGoTo0 返回当前的扩展记录数据 TrackingXRecord.GetXRecordDataXRecordDataType,XRecordData Ifwedonthaveanarrayalreadythencreateone IfVarType(XRecordDataType)AndvbArray=vbArrayThen ArraySize=UBound(XRecordDataType)+1返回扩展记录数据的元素个数 ArraySize=ArraySize+1Increasetoholdnewdata ReDimPreserveXRecordDataType(0ToArraySize) ReDimPreserveXRecordData(0ToArraySize) Else ArraySize=0 ReDimXRecordDataType(0ToArraySize)AsInteger ReDimXRecordData(0ToArraySize)AsVariant EndIf 添加新的扩展记录数据 ForthissampleweonlyappendthecurrenttimetotheXRecord XRecordDataType(ArraySize)=TYPE_STRING:XRecordData(ArraySize)=CStr(Now) TrackingXRecord.SetXRecordDataXRecordDataType,XRecordData ReadbackallXRecordDataentries TrackingXRecord.GetXRecordDataXRecordDataType,XRecordData ArraySize=UBound(XRecordDataType) RetrieveanddisplaystoredXRecordData ForiCount=0ToArraySize Getinformationforthiselement DataType=XRecordDataType(iCount) Data=XRecordData(iCount) IfDataType=TYPE_STRINGThen msg=msg&Data&vbCrLf EndIf Next MsgBoxThedataintheXRecordis:&vbCrLf&vbCrLf&msg,vbInformation ExitSub CREATE: CreatetheentitiesthatholdourXRecordData IfTrackingDictionaryIsNothingThenMakesurewehaveourtrackingobject SetTrackingDictionary=ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME) SetTrackingXRecord=TrackingDictionary.AddXRecord(TAG_XRECORD_NAME) EndIf Resume EndSub 以下是一些在开发人员手册中的关于扩展数据的示例。 将扩展数据指定给选择集中的所有对象 本例提示用户选择图形中的对象，然后将选定的对象置于选择集中，并且指定的扩展数据将附着到该选择集中的所有对象。 SubCh10_AttachXDataToSelectionSetObjects() 创建选择集 DimssetAsObject Setsset=ThisDrawing.SelectionSets.Add(SS1) 提示用户选择对象 sset.SelectOnScreen 定义扩展数据 DimappNameAsString,xdataStrAsString appName=MY_APP xdataStr=Thisissomexdata DimxdataType(0To1)AsInteger Dimxdata(0To1)AsVariant 为每个数组定义值 1001指示appName xdataType(0)=1001 2006-02-28 22:37回复举报|drawing101 初级粉丝15楼 xdata(0)=appName 1000指示字符串值 xdataType(1)=1000 xdata(1)=xdataStr 遍历选择集中的所有图元 将扩展数据设置和指定给每个图元 DimentAsObject ForEachentInsset ent.SetXDataxdataType,xdata Nextent EndSub 查看选择集中所有对象的扩展数据 本例显示上例所附着的扩展数据。如果附着的扩展数据不是字符串（类型1000）类型，则需要修改此代码。 SubCh10_ViewXData() 查找上例中创建的选择集 DimssetAsObject Setsset=ThisDrawing.SelectionSets.Item(SS1) 定义扩展数据变量以保存扩展数据信息 DimxdataTypeAsVariant DimxdataAsVariant DimxdAsVariant 定义索引计数器 DimxdiAsInteger xdi=0 遍历选择集中的对象 并检索对象的扩展数据 DimmsgstrAsString DimappNameAsString DimentAsAcadEntity appName=MY_APP ForEachentInsset msgstr= xdi=0 检索appName扩展数据类型和值 ent.GetXDataappName,xdataType,xdata 如果未初始化xdataType变量， 则没有可供该图元检索的appName扩展数据 IfVarType(xdataType)vbEmptyThen ForEachxdInxdata msgstr=msgstr&vbCrLf&xdataType(xdi)_ &:&xd xdi=xdi+1 Nextxd EndIf 如果msgstr变量为NULL，则没有扩展数据 Ifmsgstr=Thenmsgstr=vbCrLf&NONE MsgBoxappName&xdataon&ent.ObjectName&_ :&vbCrLf&msgstr Nextent EndSub 选择包含扩展数据的圆 下例过滤包含由“MY_APP”应用程序添加的扩展数据的圆： SubCh4_FilterXdata() DimsstextAsAcadSelectionSet DimmodeAsInteger DimpointsArray(0To11)AsDouble mode=acSelectionSetWindowPolygon pointsArray(0)=-12#:pointsArray(1)=-7#:pointsArray(2)=0 pointsArray(3)=-12#:pointsArray(4)=10#:pointsArray(5)=0 pointsArray(6)=10#:pointsArray(7)=10#:pointsArray(8)=0 pointsArray(9)=10#:pointsArray(10)=-7#:pointsArray(11)=0 DimFilterType(1)AsInteger DimFilterData(1)AsVariant Setsstext=ThisDrawing.SelectionSets.Add(SS9) FilterType(0)=0 FilterData(0)=Circle FilterType(1)=1001 FilterData(1)=MY_APP sstext.SelectByPolygonmode,pointsArray,FilterType,FilterData EndSub - yfy20032004-06-3020:02 14、文件系统的操作 文件系统对象（FileSystemObject）提供对计算机文件系统的访问。主要包含驱动器对象（Drive对象）、目录对象（Folder对象）、文件对象（File对象）和流对象（TextStream对象）。 FileSystemObject对象提供了几个对于文件操作的函数，如用FileExists方法判断指定的文件是否存在，用CreateTextFile创建一个指定文件名的文件，用OpenTextFile打开一个指定的文件等。 TextStream对象则对打开的文件进行操作，如用AtEndOfStream判断是否到达文件的末尾，用Read、ReadAll和ReadLine方法分别读取一定数量的字符、全部或者一行的内容，而用Skip、SkipLine方法跳过指定数量的字符或者一行，用Write、WriteBlankLines和WriteLine分别写入一定数量的字符、换行符或者一行。 更具体的可以参考VB的语言参考手册和VBScript的帮助文件。 FileSystemObject示例代码 Copyright1998MicrosoftCorporation。保留所有权利。 2006-02-28 22:37回复举报|drawing101 初级粉丝16楼 OptionExplicit 对于代码质量： 1)下面的代码有许多字符串操作，用&运算符来把短字符串连接在一起。由于 字符串连接是费时的，所以这是一种低效率的写代码方法。无论如何，它是 一种非常好维护的写代码方法，并且在这儿使用了这种方法，因为该程序执行 大量的磁盘操作，而磁盘操作比连接字符串所需的内存操作要慢得多。 记住这是示范代码，而不是产品代码。 2)使用了OptionExplicit，因为访问声明过的变量，比访问未声明的变量要 稍微快一些。它还能阻止在代码中发生错误，例如，把DriveTypeCDROM误拼 成了DriveTypeCDORM。 3)为了使代码更可读，该代码中没有错误处理。虽然采取了防范措施，来保证代码 在普通情况下没有错误，但文件系统是不可预知的。在产品代码中，使用 OnErrorResumeNext和Err对象来捕获可能发生的错误。 一些容易取得的全局变量 DimTabStop DimNewLine ConstTestDrive=C ConstTestFilePath=C:Test 由Drive.DriveType返回的常数 ConstDriveTypeRemovable=1 ConstDriveTypeFixed=2 ConstDriveTypeNetwork=3 ConstDriveTypeCDROM=4 ConstDriveTypeRAMDisk=5 由File.Attributes返回的常数 ConstFileAttrNormal=0 ConstFileAttrReadOnly=1 ConstFileAttrHidden=2 ConstFileAttrSystem=4 ConstFileAttrVolume=8 ConstFileAttrDirectory=16 ConstFileAttrArchive=32 ConstFileAttrAlias=64 ConstFileAttrCompressed=128 用来打开文件的常数 ConstOpenFileForReading=1 ConstOpenFileForWriting=2 ConstOpenFileForAppending=8 ShowDriveType 目的： 生成一个字符串，来描述给定Drive对象的驱动器类型。 示范下面的内容 -Drive.DriveType FunctionShowDriveType(Drive) DimS SelectCaseDrive.DriveType CaseDriveTypeRemovable S=Removable CaseDriveTypeFixed S=Fixed CaseDriveTypeNetwork S=Network CaseDriveTypeCDROM S=CD-ROM CaseDriveTypeRAMDisk S=RAMDisk CaseElse S=Unknown EndSelect ShowDriveType=S EndFunction ShowFileAttr 目的： 生成一个字符串，来描述文件或文件夹的属性。 示范下面的内容 -File.Attributes -Folder.Attributes 2006-02-28 22:37回复举报|drawing101 初级粉丝17楼 FunctionShowFileAttr(File)File可以是文件或文件夹 DimS DimAttr Attr=File.Attributes IfAttr=0Then ShowFileAttr=Normal ExitFunction EndIf IfAttrAndFileAttrDirectoryThenS=S&Directory IfAttrAndFileAttrReadOnlyThenS=S&Read-Only IfAttrAndFileAttrHiddenThenS=S&Hidden IfAttrAndFileAttrSystemThenS=S&System IfAttrAndFileAttrVolumeThenS=S&Volume IfAttrAndFileAttrArchiveThenS=S&Archive IfAttrAndFileAttrAliasThenS=S&Alias IfAttrAndFileAttrCompressedThenS=S&Compressed ShowFileAttr=S EndFunction GenerateDriveInformation 目的： 生成一个字符串，来描述可用驱动器的当前状态。 示范下面的内容 -FileSystemObject.Drives -IteratingtheDrivescollection -Drives.Count -Drive.AvailableSpace -Drive.DriveLetter -Drive.DriveType -Drive.FileSystem -Drive.FreeSpace -Drive.IsReady -Drive.Path -Drive.SerialNumber -Drive.ShareName -Drive.TotalSize -Drive.VolumeName FunctionGenerateDriveInformation(FSO) DimDrives DimDrive DimS SetDrives=FSO.Drives S=Numberofdrives:&TabStop&Drives.Count&NewLine&NewLine 构造报告的第一行。 S=S&String(2,TabStop)&Drive S=S&String(3,TabStop)&File S=S&TabStop&Total S=S&TabSt