关闭

关闭

关闭

封号提示

内容

首页 CAD应用二次开发VB和VBA开发CAD的知识

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

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

陈志盛
2017-09-18 0人阅读 举报 0 0 暂无简介

简介:本文档为《CAD应用二次开发VB和VBA开发CAD的知识doc》,可适用于综合领域

关于CAD应用二次开发VB和VBA开发CAD的知识.doc文档,大发5分快3拥有内容丰富的相关文档,站内每天千位行业名人共享最新资料。

CAD应用二次开发VB和VBA开发CAD的知识、如何在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图形。示例:DimacadAppAsAcadApplicationDimacadDocasAcadDocumentSubConnectToAcad()OnErrorResumeNextSetacadApp=GetObject(,"AutoCADApplication")IfErrThenErrClearSetacadApp=CreateObject("AutoCADApplication")IfErrThenEndEndIfacadAppVisible=TrueSetacadDoc=acadAppActiveDocumentEndSub、如何使VB开发的程序不依赖于AutoCAD的版本。启动VB定义模块级变量AutoCAD应用程序(acadApp)和当前的文档(acadDoc)。如果AutoCAD正在运行使用GetObject函数将检索AutoCADApplication对象。如果AutoCAD没有运行使用CreateObject函数试图创建一个AutoCADApplication对象。如果创建成功会启动AutoCAD如果失败则会发生错误。同时运行多个AutoCAD任务时GetObject函数会返回Windows运行对象表中的第一个AutoCAD实例。要显示AutoCAD图形窗口需要将AutoCAD应用程序的Visible特性设置为TRUE记录数据的区别是:扩展数据有K存储空间的限制并且使用及以上的组码值而扩展记录数据则没有空间和顺序的限制并且组码在以下。还有一个不同之处是可以在选择集中操作扩展数据。ACAD提供了SetXData和GetXData的函数来设置和返回扩展数据通常扩展数据需要提供一个已经注册的应用程序(RegisteredApplication)名称作为不同程序之间的数据区分。ACAD也提供了SetXRecordData和GetXRecordData的函数来设置和返回扩展记录数据但是由于扩展记录数据是保存于扩展词典(ExtensionDictionary)中的因而要用HasExtensionDictionary来判断是否包含扩展词典而用GetExtensionDictionary来返回扩展词典如不存在它就会创建一个。再通过扩展词典的GetObject来返回扩展记录对象AddXRecord添加一个扩展记录对象。示例:SubExampleXData()'这个例子创建一条直线并且添加扩展数据'创建直线DimlineObjAsAcadLineDimstartPt(To)AsDouble,endPt(To)AsDoublestartPt()=#:startPt()=#:startPt()=#endPt()=#:endPt()=#:endPt()=#SetlineObj=ThisDrawingModelSpaceAddLine(startPt,endPt)'初始化所有的扩展数据。注意第一个值必须是应用程序名称而它的组码必须是。DimDataType(To)AsIntegerDimData(To)AsVariantDimreals(To)AsDoubleDimworldPos(To)AsDoubleDataType()=:Data()="TestApplication"DataType()=:Data()="Thisisatestforxdata"DataType()=:Data()=""'层DataType()=:Data()=E'实数DataType()=:Data()='距离DataType()=:Data()='位整数DataType()=:Data()='位整数DataType()=:Data()='比例因子reals()=:reals()=:reals()=DataType()=:Data()=reals'实数worldPos()=:worldPos()=:worldPos()=DataType()=:Data()=worldPos'worldspaceposition:回复举报|楼'在直线上附着扩展数据lineObjSetXDataDataType,Data'返回直线的扩展数据drawingDimxdataOutAsVariantDimxtypeOutAsVariant初级粉丝lineObjGetXData"",xtypeOut,xdataOutEndSub示例:SubExampleXRecordData()'这个例子当扩展记录对象不存在时创建一个新的扩展记录对象并且添加扩展记录数据。DimTrackingDictionaryAsAcadDictionary,TrackingXRecordAsAcadXRecordDimXRecordDataTypeAsVariant,XRecordDataAsVariantDimArraySizeAsLong,iCountAsLongDimDataTypeAsInteger,DataAsString,msgAsString'UniqueidentifierstodistinguishourXRecordDatafromotherXRecordDataConstTYPESTRING=ConstTAGDICTIONARYNAME="ObjectTrackerDictionary"ConstTAGXRECORDNAME="ObjectTrackerXRecord"'连接扩展词典OnErrorGoToCREATESetTrackingDictionary=ThisDrawingDictionaries(TAGDICTIONARYNAME)SetTrackingXRecord=TrackingDictionaryGetObject(TAGXRECORDNAME)OnErrorGoTo'返回当前的扩展记录数据TrackingXRecordGetXRecordDataXRecordDataType,XRecordData'Ifwedon'thaveanarrayalreadythencreateoneIfVarType(XRecordDataType)AndvbArray=vbArrayThenArraySize=UBound(XRecordDataType)'返回扩展记录数据的元素个数ArraySize=ArraySize'IncreasetoholdnewdataReDimPreserveXRecordDataType(ToArraySize)ReDimPreserveXRecordData(ToArraySize)ElseArraySize=ReDimXRecordDataType(ToArraySize)AsIntegerReDimXRecordData(ToArraySize)AsVariantEndIf'添加新的扩展记录数据'ForthissampleweonlyappendthecurrenttimetotheXRecordXRecordDataType(ArraySize)=TYPESTRING:XRecordData(ArraySize)=CStr(Now)TrackingXRecordSetXRecordDataXRecordDataType,XRecordData'ReadbackallXRecordDataentriesTrackingXRecordGetXRecordDataXRecordDataType,XRecordDataArraySize=UBound(XRecordDataType)'RetrieveanddisplaystoredXRecordDataForiCount=ToArraySize'GetinformationforthiselementDataType=XRecordDataType(iCount)Data=XRecordData(iCount)IfDataType=TYPESTRINGThenmsg=msgDatavbCrLfEndIfNextMsgBox"ThedataintheXRecordis:"vbCrLfvbCrLfmsg,vbInformationExitSubCREATE:'CreatetheentitiesthatholdourXRecordDataIfTrackingDictionaryIsNothingThen'MakesurewehaveourtrackingobjectSetTrackingDictionary=ThisDrawingDictionariesAdd(TAGDICTIONARYNAME)SetTrackingXRecord=TrackingDictionaryAddXRecord(TAGXRECORDNAME)EndIfResumeEndSub以下是一些在开发人员手册中的关于扩展数据的示例。将扩展数据指定给选择集中的所有对象本例提示用户选择图形中的对象然后将选定的对象置于选择集中并且指定的扩展数据将附着到该选择集中的所有对象。SubChAttachXDataToSelectionSetObjects()'创建选择集DimssetAsObjectSetsset=ThisDrawingSelectionSetsAdd("SS")'提示用户选择对象ssetSelectOnScreen'定义扩展数据DimappNameAsString,xdataStrAsStringappName="MYAPP"xdataStr="Thisissomexdata"DimxdataType(To)AsIntegerDimxdata(To)AsVariant'为每个数组定义值'指示appNamexdataType()=:回复举报|楼xdata()=appName'指示字符串值xdataType()=xdata()=xdataStrdrawing'遍历选择集中的所有图元初级粉丝'将扩展数据设置和指定给每个图元DimentAsObjectForEachentInssetentSetXDataxdataType,xdataNextentEndSub查看选择集中所有对象的扩展数据本例显示上例所附着的扩展数据。如果附着的扩展数据不是字符串(类型)类型则需要修改此代码。SubChViewXData()'查找上例中创建的选择集DimssetAsObjectSetsset=ThisDrawingSelectionSetsItem("SS")'定义扩展数据变量以保存扩展数据信息DimxdataTypeAsVariantDimxdataAsVariantDimxdAsVariant'定义索引计数器DimxdiAsIntegerxdi='遍历选择集中的对象'并检索对象的扩展数据DimmsgstrAsStringDimappNameAsStringDimentAsAcadEntityappName="MYAPP"ForEachentInssetmsgstr=""xdi='检索appName扩展数据类型和值entGetXDataappName,xdataType,xdata'如果未初始化xdataType变量'则没有可供该图元检索的appName扩展数据IfVarType(xdataType)<>vbEmptyThenForEachxdInxdatamsgstr=msgstrvbCrLfxdataType(xdi)":"xdxdi=xdiNextxdEndIf'如果msgstr变量为则没有扩展数据Ifmsgstr=""Thenmsgstr=vbCrLf"NONE"MsgBoxappName"xdataon"entObjectName":"vbCrLfmsgstrNextentEndSub选择包含扩展数据的圆下例过滤包含由“MYAPP”应用程序添加的扩展数据的圆:SubChFilterXdata()DimsstextAsAcadSelectionSetDimmodeAsIntegerDimpointsArray(To)AsDoublemode=acSelectionSetWindowPolygonpointsArray()=#:pointsArray()=#:pointsArray()=pointsArray()=#:pointsArray()=#:pointsArray()=pointsArray()=#:pointsArray()=#:pointsArray()=pointsArray()=#:pointsArray()=#:pointsArray()=DimFilterType()AsIntegerDimFilterData()AsVariantSetsstext=ThisDrawingSelectionSetsAdd("SS")FilterType()=FilterData()="Circle"FilterType()=FilterData()="MYAPP"sstextSelectByPolygonmode,pointsArray,FilterType,FilterDataEndSubyfy:、文件系统的操作文件系统对象(FileSystemObject)提供对计算机文件系统的访问。主要包含驱动器对象(Drive对象)、目录对象(Folder对象)、文件对象(File对象)和流对象(TextStream对象)。FileSystemObject对象提供了几个对于文件操作的函数如用FileExists方法判断指定的文件是否存在用CreateTextFile创建一个指定文件名的文件用OpenTextFile打开一个指定的文件等。TextStream对象则对打开的文件进行操作如用AtEndOfStream判断是否到达文件的末尾用Read、ReadAll和ReadLine方法分别读取一定数量的字符、全部或者一行的内容而用Skip、SkipLine方法跳过指定数量的字符或者一行用Write、WriteBlankLines和WriteLine分别写入一定数量的字符、换行符或者一行。更具体的可以参考VB的语言参考手册和VBScript的帮助文件。''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FileSystemObject示例代码''CopyrightMicrosoftCorporation。保留所有权利。''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''':回复举报|楼OptionExplicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''drawing''对于代码质量:初级粉丝'')下面的代码有许多字符串操作用""运算符来把短字符串连接在一起。由于'字符串连接是费时的所以这是一种低效率的写代码方法。无论如何它是'一种非常好维护的写代码方法并且在这儿使用了这种方法因为该程序执行'大量的磁盘操作而磁盘操作比连接字符串所需的内存操作要慢得多。'记住这是示范代码而不是产品代码。'')使用了"OptionExplicit"因为访问声明过的变量比访问未声明的变量要'稍微快一些。它还能阻止在代码中发生错误例如把DriveTypeCDROM误拼'成了DriveTypeCDORM。'')为了使代码更可读该代码中没有错误处理。虽然采取了防范措施来保证代码'在普通情况下没有错误但文件系统是不可预知的。在产品代码中使用'OnErrorResumeNext和Err对象来捕获可能发生的错误。'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''一些容易取得的全局变量'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''DimTabStopDimNewLineConstTestDrive="C"ConstTestFilePath="C:Test"''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''由DriveDriveType返回的常数'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ConstDriveTypeRemovable=ConstDriveTypeFixed=ConstDriveTypeNetwork=ConstDriveTypeCDROM=ConstDriveTypeRAMDisk=''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''由FileAttributes返回的常数'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ConstFileAttrNormal=ConstFileAttrReadOnly=ConstFileAttrHidden=ConstFileAttrSystem=ConstFileAttrVolume=ConstFileAttrDirectory=ConstFileAttrArchive=ConstFileAttrAlias=ConstFileAttrCompressed=''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''用来打开文件的常数'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ConstOpenFileForReading=ConstOpenFileForWriting=ConstOpenFileForAppending=''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ShowDriveType''目的:''生成一个字符串来描述给定Drive对象的驱动器类型。''示范下面的内容''DriveDriveType'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionShowDriveType(Drive)DimSSelectCaseDriveDriveTypeCaseDriveTypeRemovableS="Removable"CaseDriveTypeFixedS="Fixed"CaseDriveTypeNetworkS="Network"CaseDriveTypeCDROMS="CDROM"CaseDriveTypeRAMDiskS="RAMDisk"CaseElseS="Unknown"EndSelectShowDriveType=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''ShowFileAttr''目的:''生成一个字符串来描述文件或文件夹的属性。''示范下面的内容''FileAttributes'FolderAttributes''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''':回复举报|楼FunctionShowFileAttr(File)'File可以是文件或文件夹DimSdrawingDimAttr初级粉丝Attr=FileAttributesIfAttr=ThenShowFileAttr="Normal"ExitFunctionEndIfIfAttrAndFileAttrDirectoryThenS=S"Directory"IfAttrAndFileAttrReadOnlyThenS=S"ReadOnly"IfAttrAndFileAttrHiddenThenS=S"Hidden"IfAttrAndFileAttrSystemThenS=S"System"IfAttrAndFileAttrVolumeThenS=S"Volume"IfAttrAndFileAttrArchiveThenS=S"Archive"IfAttrAndFileAttrAliasThenS=S"Alias"IfAttrAndFileAttrCompressedThenS=S"Compressed"ShowFileAttr=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GenerateDriveInformation''目的:''生成一个字符串来描述可用驱动器的当前状态。''示范下面的内容''FileSystemObjectDrives'IteratingtheDrivescollection'DrivesCount'DriveAvailableSpace'DriveDriveLetter'DriveDriveType'DriveFileSystem'DriveFreeSpace'DriveIsReady'DrivePath'DriveSerialNumber'DriveShareName'DriveTotalSize'DriveVolumeName'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGenerateDriveInformation(FSO)DimDrivesDimDriveDimSSetDrives=FSODrivesS="Numberofdrives:"TabStopDrivesCountNewLineNewLine'构造报告的第一行。S=SString(,TabStop)"Drive"S=SString(,TabStop)"File"S=STabStop"Total"S=STabStop"Free"S=STabStop"Available"S=STabStop"Serial"NewLine'构造报告的第二行。S=S"Letter"S=STabStop"Path"S=STabStop"Type"S=STabStop"Ready"S=STabStop"Name"S=STabStop"System"S=STabStop"Space"S=STabStop"Space"S=STabStop"Space"S=STabStop"Number"NewLine'分隔行。S=SString(,"")NewLineForEachDriveInDrivesS=SDriveDriveLetterS=STabStopDrivePathS=STabStopShowDriveType(Drive)S=STabStopDriveIsReadyIfDriveIsReadyThenIfDriveTypeNetwork=DriveDriveTypeThenS=STabStopDriveShareNameElseS=STabStopDriveVolumeNameEndIfS=STabStopDriveFileSystemS=STabStopDriveTotalSizeS=STabStopDriveFreeSpaceS=STabStopDriveAvailableSpaceS=STabStopHex(DriveSerialNumber)EndIfS=SNewLineNextGenerateDriveInformation=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GenerateFileInformation''目的:''生成一个字符串来描述文件的当前状态。''示范下面的内容''FilePath'FileName'FileType'FileDateCreated'FileDateLastAccessed'FileDateLastModified'FileSize'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGenerateFileInformation(File)DimSS=NewLine"Path:"TabStopFilePathS=SNewLine"Name:"TabStopFileName:回复举报|楼S=SNewLine"Type:"TabStopFileTypeS=SNewLine"Attribs:"TabStopShowFileAttr(File)S=SNewLine"Created:"TabStopFileDateCreatedS=SNewLine"Accessed:"TabStopFileDateLastAccesseddrawingS=SNewLine"Modified:"TabStopFileDateLastModifiedS=SNewLine"Size"TabStopFileSizeNewLine初级粉丝GenerateFileInformation=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GenerateFolderInformation''目的:''生成一个字符串来描述文件夹的当前状态。''示范下面的内容''FolderPath'FolderName'FolderDateCreated'FolderDateLastAccessed'FolderDateLastModified'FolderSize'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGenerateFolderInformation(Folder)DimSS="Path:"TabStopFolderPathS=SNewLine"Name:"TabStopFolderNameS=SNewLine"Attribs:"TabStopShowFileAttr(Folder)S=SNewLine"Created:"TabStopFolderDateCreatedS=SNewLine"Accessed:"TabStopFolderDateLastAccessedS=SNewLine"Modified:"TabStopFolderDateLastModifiedS=SNewLine"Size:"TabStopFolderSizeNewLineGenerateFolderInformation=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GenerateAllFolderInformation''目的:''生成一个字符串来描述一个文件夹和所有文件及子文件夹的当前状态。''示范下面的内容''FolderPath'FolderSubFolders'FoldersCount'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGenerateAllFolderInformation(Folder)DimSDimSubFoldersDimSubFolderDimFilesDimFileS="Folder:"TabStopFolderPathNewLineNewLineSetFiles=FolderFilesIf=FilesCountThenS=S"Thereisfile"NewLineElseS=S"Thereare"FilesCount"files"NewLineEndIfIfFilesCount<>ThenForEachFileInFilesS=SGenerateFileInformation(File)NextEndIfSetSubFolders=FolderSubFoldersIf=SubFoldersCountThenS=SNewLine"Thereissubfolder"NewLineNewLineElseS=SNewLine"Thereare"SubFoldersCount"subfolders"NewLineNewLineEndIfIfSubFoldersCount<>ThenForEachSubFolderInSubFoldersS=SGenerateFolderInformation(SubFolder)NextS=SNewLineForEachSubFolderInSubFoldersS=SGenerateAllFolderInformation(SubFolder)NextEndIfGenerateAllFolderInformation=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GenerateTestInformation''目的:''生成一个字符串来描述C:Test文件夹和所有文件及子文件夹的当前状态。''示范下面的内容''FileSystemObjectDriveExists'FileSystemObjectFolderExists'FileSystemObjectGetFolder'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGenerateTestInformation(FSO):回复举报|楼DimTestFolderDimSIfNotFSODriveExists(TestDrive)ThenExitFunctiondrawingIfNotFSOFolderExists(TestFilePath)ThenExitFunction初级粉丝SetTestFolder=FSOGetFolder(TestFilePath)GenerateTestInformation=GenerateAllFolderInformation(TestFolder)EndFunctionyfy:''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''DeleteTestDirectory''目的:''清理test目录。''示范下面的内容''FileSystemObjectGetFolder'FileSystemObjectDeleteFile'FileSystemObjectDeleteFolder'FolderDelete'FileDelete'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''SubDeleteTestDirectory(FSO)DimTestFolderDimSubFolderDimFile'有两种方法可用来删除文件:FSODeleteFile(TestFilePath"BeatlesOctopusGardentxt")SetFile=FSOGetFile(TestFilePath"BeatlesBathroomWindowtxt")FileDelete'有两种方法可用来删除文件夹:FSODeleteFolder(TestFilePath"Beatles")FSODeleteFile(TestFilePath"ReadMetxt")SetTestFolder=FSOGetFolder(TestFilePath)TestFolderDeleteEndSub''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''CreateLyrics''目的:''在文件夹中创建两个文本文件。'''示范下面的内容''FileSystemObjectCreateTextFile'TextStreamWriteLine'TextStreamWrite'TextStreamWriteBlankLines'TextStreamClose'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''SubCreateLyrics(Folder)DimTextStreamSetTextStream=FolderCreateTextFile("OctopusGardentxt")TextStreamWrite("Octopus'Garden")'请注意该语句不添加换行到文件中。TextStreamWriteLine("(byRingoStarr)")TextStreamWriteBlankLines()TextStreamWriteLine("I'dliketobeundertheseainanoctopus'gardenintheshade,")TextStreamWriteLine("He'dletusin,knowswherewe'vebeeninhisoctopus'gardenintheshade")TextStreamWriteBlankLines()TextStreamCloseSetTextStream=FolderCreateTextFile("BathroomWindowtxt")TextStreamWriteLine("SheCameInThroughTheBathroomWindow(byLennonMcCartney)")TextStreamWriteLine("")TextStreamWriteLine("Shecameinthroughthebathroomwindowprotectedbyasilverspoon")TextStreamWriteLine("Butnowshesucksherthumbandwandersbythebanksofherownlagoon")TextStreamWriteBlankLines()TextStreamCloseEndSub''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''GetLyrics''目的:''显示lyrics文件的内容。'''示范下面的内容''FileSystemObjectOpenTextFile'FileSystemObjectGetFile'TextStreamReadAll'TextStreamClose'FileOpenAsTextStream'TextStreamAtEndOfStream'TextStreamReadLine'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionGetLyrics(FSO)DimTextStreamDimSDimFile'有多种方法可用来打开一个文本文件和多种方法来从文件读取数据。:回复举报|楼'这儿用了两种方法来打开文件和读取文件:SetTextStream=FSOOpenTextFile(TestFilePath"BeatlesOctopusGardentxt",OpenFileForReading)drawingS=TextStreamReadAllNewLineNewLineTextStreamClose初级粉丝SetFile=FSOGetFile(TestFilePath"BeatlesBathroomWindowtxt")SetTextStream=FileOpenAsTextStream(OpenFileForReading)DoWhileNotTextStreamAtEndOfStreamS=STextStreamReadLineNewLineLoopTextStreamCloseGetLyrics=SEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''BuildTestDirectory''目的:''创建一个目录分层结构来示范FileSystemObject。''以这样的次序来创建分层结构:''C:Test'C:TestReadMetxt'C:TestBeatles'C:TestBeatlesOctopusGardentxt'C:TestBeatlesBathroomWindowtxt'''示范下面的内容''FileSystemObjectDriveExists'FileSystemObjectFolderExists'FileSystemObjectCreateFolder'FileSystemObjectCreateTextFile'FoldersAdd'FolderCreateTextFile'TextStreamWriteLine'TextStreamClose'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FunctionBuildTestDirectory(FSO)DimTestFolderDimSubFoldersDimSubFolderDimTextStream'排除(a)驱动器不存在或(b)要创建的目录已经存在的情况。IfNotFSODriveExists(TestDrive)ThenBuildTestDirectory=FalseExitFunctionEndIfIfFSOFolderExists(TestFilePath)ThenBuildTestDirectory=FalseExitFunctionEndIfSetTestFolder=FSOCreateFolder(TestFilePath)SetTextStream=FSOCreateTextFile(TestFilePath"ReadMetxt")TextStreamWriteLine("Mysonglyricscollection")TextStreamCloseSetSubFolders=TestFolderSubFoldersSetSubFolder=SubFoldersAdd("Beatles")CreateLyricsSubFolderBuildTestDirectory=TrueEndFunction''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''主程序''首先它创建一个test目录以及一些子文件夹和文件。'然后它转储有关可用磁盘驱动器和test目录的某些信息'最后清除test目录及其所有内容。'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''SubMainDimFSO'设立全局变量。TabStop=Chr()NewLine=Chr()SetFSO=CreateObject("ScriptingFileSystemObject")IfNotBuildTestDirectory(FSO)ThenPrint"TestdirectoryalreadyexistsorcannotbecreatedCannotcontinue"ExitSubEndIfPrintGenerateDriveInformation(FSO)NewLineNewLinePrintGenerateTestInformation(FSO)NewLineNewLinePrintGetLyrics(FSO)NewLineNewLineDeleteTestDirectory(FSO)EndSubyfy:、Excel文件的操作Excel应用程序对象(Application)提供了对Excel应用程序控制的接口。它包括工作簿对象(Workbook对象)代表当前打开的一个Excel文件(文档)。而一个工作簿又包含了一些工作表对象(Worksheet对象)代表工作簿中的一张工作表。Cell代表工作表中的一个单元格而Range是由一个或者多个单元格构成的区域。在Excel电子表格中列出AutoCAD属性:回复举报|楼以下子例程在当前图形中查找所有的块引用然后查找附着到这些块引用的属性并将它们列在Excel电子表格中。要运行本样例请按以下步骤执行:打开包含块引用的图形这些块引用带有属性。(样例图drawing形sampleactiveXattribdwg包含这样的块引用。)使用AutoCADVBAIDE命令打开VBAIDE。初级粉丝使用VBAIDE中的“工具”“引用”菜单选项选择MicrosoftExcel对象模型。将这个子例程复制到VBA的“代码”窗口中并运行它。SubChExtract()DimExcelAsExcelApplicationDimExcelSheetAsObjectDimExcelWorkbookAsObjectDimRowNumAsIntegerDimHeaderAsBooleanDimelemAsAcadEntityDimArrayAsVariantDimCountAsInteger'启动Excel。SetExcel=NewExcelApplication'创建新的工作簿并查找活动电子表格。SetExcelWorkbook=ExcelWorkbooksAddSetExcelSheet=ExcelActiveSheetExcelWorkbookSaveAs"Attributexls"RowNum=Header=False'遍历模型空间查找'所有的块引用。ForEachelemInThisDrawingModelSpaceWithelem'找到块引用时'检查其属性IfStrComp(EntityName,"AcDbBlockReference",)=ThenIfHasAttributesThen'获取属性Array=GetAttributes'将属性的标记字符串'复制到ExcelForCount=LBound(Array)ToUBound(Array)IfHeader=FalseThenIfStrComp(Array(Count)EntityName,"AcDbAttribute",)=ThenExcelSheetCells(RowNum,Count)value=Array(Count)TagStringEndIfEndIfNextCountRowNum=RowNumForCount=LBound(Array)ToUBound(Array)ExcelSheetCells(RowNum,Count)value=Array(Count)textStringNextCountHeader=TrueEndIfEndIfEndWithNextelemExcelApplicationQuitEndSub、使用ADO操作Access数据库ADO的Connection对象提供了连接数据库的方法也可以看做是对数据库进行控制的接口。它主要包括数据集对象(Recordset对象)代表返回数据库中的数据记录还有命令对象(Command对象)执行一些SQL语句。Connection对象的Provider属性是提供者的名称ConnectionString属性是建立到数据源的连接的信息。Open方法是打开到数据源的连接Execute方法是执行指定的SQL语句。Recordset对象的Open方法是返回表的记录或者执行SQL语句查询等的结果。Command对象的Execute方法是执行SQL语句如插入、更新、删除记录等。示例:PublicSubExampleADO()DimcnnAsADODBConnectionSetcnn=NewADODBConnection'打开连接'、在连接字符串外指定提供者'cnnProvider="MicrosoftJetOLEDB"'strCnn="DataSource=c:MyDbmdb"'cnnOpenstrCnn'、在Open语句外指定连接字符串'cnnConnectionString="Provider=MicrosoftJetOLEDBDataSource=c:MyDbmdb"'cnnOpenstrCnn="Provider=MicrosoftJetOLEDB""DataSource=c:MyDbmdb"cnnOpenstrCnnDimrstAsADODBRecordsetSetrst=NewADODBRecordset'打开表rstCursorType=adOpenKeysetrstLockType=adLockOptimisticrstOpen"employee",cnn,,,adCmdTable'执行SQL语句DimcmdAsADODBCommandSetcmd=NewADODBCommandSetcmdActiveConnection=cnncmdCommandText="UPDATETitlesSETType='selfhelp'WHEREType='psychology'"rstClosecnnCloseEndSu