1、如何在 VB 中连接 AutoCAD。
启动 VB ，引⽤ AutoCAD 类型库。操作步骤：从“⼯程”菜单中选择“引⽤”选项，启动“引⽤”对话框。在“引⽤”对话框中，选择AutoCAD 类型库，然后单击“确定”。
定义模块级变量 AutoCAD 应⽤程序 (acadApp) 和当前的⽂档 (acadDoc)。
如果 AutoCAD 正在运⾏，使⽤ GetObject 函数将检索 AutoCAD Application 对象。如果 AutoCAD 没有运⾏，使⽤
CreateObject 函数试图创建⼀个 AutoCAD Application 对象。如果创建成功，会启动 AutoCAD；如果失败，则会发⽣错误。同时运⾏多个 AutoCAD 任务时，GetObject 函数会返回 Windows 运⾏对象表中的第⼀个 AutoCAD 实例。要显⽰ AutoCAD 图形窗⼝，需要将 AutoCAD 应⽤程序的 Visible 特性设置为 TRUE。使⽤ acadDoc 变量引⽤当前的 AutoCAD 图形。⽰例：
Dim acadApp As AcadApplicationDim acadDoc as AcadDocumentSub ConnectToAcad()On Error Resume Next
Set acadApp = GetObject(, \"AutoCAD.Application\")If Err ThenErr.Clear
Set acadApp = CreateObject(\"AutoCAD.Application\")If Err Then EndEnd If
acadApp.Visible = True
Set acadDoc = acadApp.ActiveDocumentEnd Sub
2、如何使 VB 开发的程序不依赖于 AutoCAD 的版本。
启动 VB ，定义模块级变量 AutoCAD 应⽤程序 (acadApp) 和当前的⽂档 (acadDoc)。
如果 AutoCAD 正在运⾏，使⽤ GetObject 函数将检索 AutoCAD Application 对象。如果 AutoCAD 没有运⾏，使⽤
CreateObject 函数试图创建⼀个 AutoCAD Application 对象。如果创建成功，会启动 AutoCAD；如果失败，则会发⽣错误。同时运⾏多个 AutoCAD 任务时，GetObject 函数会返回 Windows 运⾏对象表中的第⼀个 AutoCAD 实例。要显⽰ AutoCAD 图形窗⼝，需要将 AutoCAD 应⽤程序的 Visible 特性设置为 TRUE。
使⽤ acadDoc 变量引⽤当前的 AutoCAD 图形。⽰例：
Dim acadApp As ObjectDim acadDoc as ObjectSub ConnectToAcad()
On Error Resume Next
Set acadApp = GetObject(, \"AutoCAD.Application\")If Err ThenErr.Clear
Set acadApp = CreateObject(\"AutoCAD.Application\")If Err Then EndEnd If
acadApp.Visible = True
Set acadDoc = acadApp.ActiveDocumentEnd Sub
与第⼀个问题相⽐较，可以看出，不引⽤具体的类型库以及使⽤通⽤的对象类型就可以达到通⽤性。3、前期绑定和后期绑定
要创建⼀个使⽤前期绑定⽅式的对象变量，也就是说，在程序编译时就完成绑定，则对象变量在声明时应指定类 ID，如：Dim acadApp As AcadApplication。
使⽤ As Object ⼦句声明对象变量，可以创建⼀个能包含任何类型对象引⽤的变量。不过，该变量访问对象是后期绑定的，也就是说，绑定在程序运⾏时才进⾏，如：Dim acadApp As Object。
前期绑定的变量引⽤可以提供更好的性能，但该变量只能存放声明中所指定的类的引⽤。⽽后期绑定的变量引⽤可以提供更好的通⽤性。4、依赖于版本和独⽴于版本
如果 CreateObject 或 GetObject 函数使⽤的 ProgID 没有附加版本号，那么是独⽴于版本的，否则是依赖于版本的。例如，如果使⽤的是 CreateObject，则 CreateObject (\"AutoCAD.Application\") 是独⽴于版本的，⽽ CreateObject(\"AutoCAD.Application.15\") 是依赖于版本的。
--------------------------------------------------------------------------------yfy20032004-06-30 19:595、VB 代码到 VBA 代码的转换
在 VBA 的 IDE 环境中，使⽤“导⼊⽂件”将要转换的 VB ⼯程的模块、类模块以及窗体⽂件⼀⼀导⼊。接着将 VB 代码中所有的当前的⽂档 (acadDoc) 变量替换为 ThisDrawing，⽽AutoCAD 应⽤程序 (acadApp) 变量替换为 Application。同时删除定义的 AutoCAD 应⽤程序 (acadApp) 和当前的⽂档 (acadDoc) 变量，删除与 AutoCAD 应⽤程序连接的代码。注意：要转换 VB 代码的窗体部分，则窗体必须是⽤ UserForm 创建的。顶2
2006-02-28 22:37回复
举报
|
drawing101初级粉丝1 2楼
6、图形对象和⾮图形对象
图形对象（也称为图元、实体对象）是组成图形的可见对象（例如直线、圆、光栅图像等）。⾮图形对象是指属于图形的⼀部分但不可见的（提⽰性的）对象，例如 Layers、 Linetypes、 DimStyles、 Selection Sets 等等。要创建这些对象，可使⽤Add ⽅法。每⼀个对象都有⽤于特定⽬的的⽅法和特性，都有设置和检索扩展数据以及删除⾃⼰的⽅法。7、创建图形对象
图形对象是在 ModelSpace 集合、 PaperSpace 集合或 Block 对象中创建的。使⽤变量 moSpace 设置为当前模型空间。本例使⽤ AddLightweightPolyline ⽅法创建⼀条分为两段的简单多段线，其端点坐标值分别是 (2,4)、(4,2) 和 (6,4)。Dim moSpace As AcadModelSpaceSet moSpace = acadDoc.ModelSpaceSub AddLightWeightPolyline()Dim plineObj As AcadLWPolylineDim points(0 To 5) As Double' 定义⼆维多段线的点points(0) = 2: points(1) = 4points(2) = 4: points(3) = 2points(4) = 6: points(5) = 4
' 在模型空间中创建⼀个优化多段线对象Set plineObj = moSpace.AddLightWeightPolylin e(points)End Sub
--------------------------------------------------------------------------------yfy20032004-06-30 20:008、变体型变量（Variant）和数组
变体型变量是⼀种特殊的数据类型，可以包含任何类型的数据，固定长度的字符串数据和⽤户定义的类型除外。变量还可以包含特殊值 Empty、Error、Nothing 和 NULL。可以使⽤ VarType 或 TypeName 函数来确定如何处理变量中的数据。变体型变量⽤于和 AutoCAD 传递数组数据。这表⽰使⽤对象的属性和⽅法时，如果输⼊数组作为参数，那么 VBA ⾃动将数组转换为变体型变量。此外，从函数或者对象的属性返回的数组数据也将⾃动转换为变体型变量进⾏处理。
对第七个问题进⾏分析：points数组作为参数时，将⾃动转换成变体型变量，然后才进⾏⽣成多段线的操作。同时，如果返回点坐标的数组时，必须先定义⼀个变体型变量。⽰例：
Dim moSpace As AcadModelSpace
Set moSpace = acadDoc.ModelSpaceSub AddLightWeightPolyline()Dim plineObj As AcadLWPolylineDim points(0 To 5) As Double' 定义⼆维多段线的点points(0) = 2: points(1) = 4points(2) = 4: points(3) = 2points(4) = 6: points(5) = 4
' 在模型空间中创建⼀个优化多段线对象Set plineObj = moSpace.AddLightWeightPolylin e(points)‘等效于
‘Dim vpoints As Variant‘Vpoints=points
‘Set plineObj = moSpace.AddLightWeightPolylin e(vpoints)‘返回多段线的从标数组‘Dim vpoints As Variant‘vpoints = plineObj.Coordinates
‘⽐较 vpoints 和 points，它们的维数相同，元素个数相同，值也相同。End Sub9、系统变量
Document 对象提供了 SetVariable 和 GetVariable ⽅法，分别⽤于设置和检索 AutoCAD 系统变量。例如，要将某个整数指定给 MAXSORT 系统变量，可设置为：acadDoc.SetVariable \"MAXSORT\。针对第七个问题，如果想让多段线的起点从上⼀次绘图的终点开始。那么可以检索 LASTPOINT系统变量。⽰例：
Dim moSpace As AcadModelSpaceSet moSpace = acadDoc.ModelSpaceSub AddLightWeightPolyline()Dim plineObj As AcadLWPolyline‘返回上⼀次给图最后输⼊的点坐标Dim pt as Variant
Pt=acadDoc.GetVariable(“LASTPOINT”)Dim points(0 To 5) As Double' 定义⼆维多段线的点
points(0) = pt(0): points(1) = pt(1)points(2) = 4: points(3) = 2points(4) = 6: points(5) = 4
' 在模型空间中创建⼀个优化多段线对象
Set plineObj = moSpace.AddLightWeightPolyline(points)2006-02-28 22:37回复举报 |
drawing101初级粉丝1 3楼End Sub
10、图形数据和属性数据
图形对象（也称为图元）是组成图形的可见对象（例如直线、圆、光栅图像等）。属性数据是保存图形对象的信息，⽐如圆可以代表电杆，那么圆就要保存电杆的信息如类型、地址、⾼度等。
11、随图形⼀起保存于⽂件的内部属性数据和保存于数据库的外部属性数据
属性数据可以保存于⽂件内部，⽐如扩展数据和扩展记录数据，它是随图形对象⼀起保存的，删除图形对象，将⾃动清除属性数据，因⽽管理⽅便。属性数据也可以保存于外部数据库，常见的有⽂件，如⽂本⽂件、Excel⽂件等，还有数据库，如Access、Oracle等，它需要⼈⼯⼿动进⾏管理，但数据的存取⾼效，通常是通过句柄来实现它们之间的联结。--------------------------------------------------------------------------------yfy20032004-06-30 20:0112、图形对象的句柄和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 添加⼀个扩展记录对象。⽰例：
Sub Example_XData()
' 这个例⼦创建⼀条直线，并且添加扩展数据' 创建直线
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double, endPt(0 To 2) As DoublestartPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
' 初始化所有的扩展数据。注意第⼀个值必须是应⽤程序名称，⽽它的组码必须是1001。Dim DataType(0 To 9) As IntegerDim Data(0 To 9) As VariantDim reals3(0 To 2) As DoubleDim worldPos(0 To 2) As Double
DataType(0) = 1001: Data(0) = \"Test_Application\"DataType(1) = 1000: Data(1) = \"This is a test for xdata\"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) = 32767 ' 16位整数DataType(6) = 1071: Data(6) = 32767 ' 32位整数DataType(7) = 1042: Data(7) = 10 ' ⽐例因⼦reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20DataType(8) = 1010: Data(8) = reals3 ' 实数
worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989 DataType(9) = 1011: Data(9) = worldPos ' worldspace position2006-02-28 22:37 回复举报
|
drawing101初级粉丝1 4楼
' 在直线上附着扩展数据
lineObj.SetXData DataType, Data' 返回直线的扩展数据Dim xdataOut As VariantDim xtypeOut As Variant
lineObj.GetXData \"\End Sub⽰例：
Sub Example_XRecordData()
' 这个例⼦当扩展记录对象不存在时创建⼀个新的扩展记录对象，并且添加扩展记录数据。Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRec ordDim XRecordDataType As Variant, XRecordData As VariantDim ArraySize As Long, iCount As Long
Dim DataType As Integer, Data As String, msg As String
' Unique identifiers to distinguish our XRecordData from other XRecordD ataConst TYPE_STRING = 1
Const TAG_DICTIONARY_NAME = \"ObjectTrackerDictionary\"Const TAG_XRECORD_NAME = \"ObjectTrackerXRecord\"' 连接扩展词典
On Error GoTo CREATE
Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NA ME)Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NA ME)On Error GoTo 0
' 返回当前的扩展记录数据
TrackingXRecord.GetXRecordData XRecordDataType, XRecordData' If we don't have an array already then create one
If VarType(XRecordDataType) And vbArray = vbArray Then
ArraySize = UBound(XRecordDataType) + 1 ' 返回扩展记录数据的元素个数ArraySize = ArraySize + 1 ' Increase to hold new dataReDim Preserve XRecordDataType(0 To ArraySize)ReDim Preserve XRecordData(0 To ArraySize)ElseArraySize = 0
ReDim XRecordDataType(0 To ArraySize) As IntegerReDim XRecordData(0 To ArraySize) As VariantEnd If
' 添加新的扩展记录数据
' For this sample we only append the current time to the XRecord XRecordDataType(ArraySize) = TYPE_STRING:XRecordData(ArraySize) = CStr(Now)
TrackingXRecord.SetXRecordData XRecordDataType, XRecordData' Read back all XRecordData entries
TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ArraySize = UBound(XRecordDataType)' Retrieve and display stored XRecordDataFor iCount = 0 To ArraySize' Get information for this elementDataType = XRecordDataType(iCount)Data = XRecordData(iCount)If DataType = TYPE_STRING Thenmsg = msg & Data & vbCrLfEnd IfNext
MsgBox \"The data in the XRecord is: \" & vbCrLf & vbCrLf & msg, vbInfor mationExit SubCREATE:
' Create the entities that hold our XRecordData
If TrackingDictionary Is Nothing Then ' Make sure we have our tracking o bjectSet TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY _NAME)Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_N AME)End IfResumeEnd Sub
以下是⼀些在开发⼈员⼿册中的关于扩展数据的⽰例。将扩展数据指定给选择集中的所有对象
本例提⽰⽤户选择图形中的对象，然后将选定的对象置于选择集中，并且指定的扩展数据将附着到该选择集中的所有对象。Sub Ch10_AttachXDataToSelectionSetObjects()' 创建选择集Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Add(\"SS1\")' 提⽰⽤户选择对象sset.SelectOnScreen' 定义扩展数据
Dim appName As String, xdataStr As StringappName = \"MY_APP\"xdataStr = \"This is some xdata\"Dim xdataType(0 To 1) As IntegerDim xdata(0 To 1) As Variant
' 为每个数组定义值'1001 指⽰ appNamexdataType(0) = 10012006-02-28 22:37回复举报 |
drawing101初级粉丝1 5楼
xdata(0) = appName'1000 指⽰字符串值xdataType(1) = 1000xdata(1) = xdataStr' 遍历选择集中的所有图元
' 将扩展数据设置和指定给每个图元Dim ent As ObjectFor Each ent In sset
ent.SetXData xdataType, xdataNext entEnd Sub
查看选择集中所有对象的扩展数据
本例显⽰上例所附着的扩展数据。如果附着的扩展数据不是字符串（类型 1000）类型，则需要修改此代码。Sub Ch10_ViewXData()' 查找上例中创建的选择集Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Item(\"SS1\")' 定义扩展数据变量以保存扩展数据信息Dim xdataType As VariantDim xdata As VariantDim xd As Variant'定义索引计数器Dim xdi As Integer
xdi = 0
' 遍历选择集中的对象' 并检索对象的扩展数据Dim msgstr As StringDim appName As StringDim ent As AcadEntityappName = \"MY_APP\"For Each ent In ssetmsgstr = \"\"xdi = 0
' 检索 appName 扩展数据类型和值ent.GetXData appName, xdataType, xdata' 如果未初始化 xdataType 变量，
' 则没有可供该图元检索的 appName 扩展数据If VarType(xdataType) <> vbEmpty ThenFor Each xd In xdata
msgstr = msgstr & vbCrLf & xdataType(xdi) _& \": \" & xdxdi = xdi + 1Next xdEnd If
' 如果 msgstr 变量为 NULL，则没有扩展数据
If msgstr = \"\" Then msgstr = vbCrLf & \"NONE\" MsgBox appName & \" xdata on \" & ent.ObjectName & _ \":\" & vbCrLf & msgstrNext entEnd Sub
选择包含扩展数据的圆
下例过滤包含由“MY_APP”应⽤程序添加的扩展数据的圆：Sub Ch4_FilterXdata()
Dim sstext As AcadSelectionSetDim mode As Integer
Dim pointsArray(0 To 11) As Doublemode = acSelectionSetWindowPolygon
pointsArray(0) = -12#: pointsArray(1) = -7#: pointsArray(2) = 0 pointsArray(3) = -12#: pointsArray(4) = 10#: pointsArray(5) = 0pointsArray(6) = 10#: pointsArray(7) = 10#: pointsArray(8) = 0 pointsArray(9) = 10#: pointsArray(10) = -7#: pointsArray(11) = 0Dim FilterType(1) As IntegerDim FilterData(1) As Variant
Set sstext = ThisDrawing.SelectionSets.Add(\"SS9\")FilterType(0) = 0FilterData(0) = \"Circle\"FilterType(1) = 1001FilterData(1) = \"MY_APP\"
sstext.SelectByPolygon mode, pointsArray, FilterType, FilterDataEnd Sub
--------------------------------------------------------------------------------yfy20032004-06-30 20:0214、⽂件系统的操作
⽂件系统对象（FileSystemObject）提供对计算机⽂件系统的访问。主要包含驱动器对象（Drive对象）、⽬录对象（Folder对象）、⽂件对象（File对象）和流对象（TextStream对象）。FileSystemObject对象提供了⼏个对于⽂件操作的函数，如⽤FileExists⽅法判断指定的⽂件是否存在，⽤CreateTextFile创建⼀个指定⽂件名的⽂件，⽤OpenTextFile打开⼀个指定的⽂件等。TextStream对象则对打开的⽂件进⾏操作，如⽤AtEndOfStream判断是否到达⽂件的末尾，⽤Read、ReadAll和
ReadLine⽅法分别读取⼀定数量的字符、全部或者⼀⾏的内容，⽽⽤Skip、SkipLine⽅法跳过指定数量的字符或者⼀⾏，⽤Write、WriteBlankLines和
WriteLine分别写⼊⼀定数量的字符、换⾏符或者⼀⾏。更具体的可以参考VB的语⾔参考⼿册和VBScript的帮助⽂件。'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FileSystemObject ⽰例代码'
'Copyright 1998 Microsoft Corporation。保留所有权利。'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''2006-02-28 22:37回复举报
|
drawing101初级粉丝1 6楼
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 对于代码质量：'
' 1) 下⾯的代码有许多字符串操作，⽤\"&\"运算符来把短字符串连接在⼀起。由于' 字符串连接是费时的，所以这是⼀种低效率的写代码⽅法。⽆论如何，它是' ⼀种⾮常好维护的写代码⽅法，并且在这⼉使⽤了这种⽅法，因为该程序执⾏' ⼤量的磁盘操作，⽽磁盘操作⽐连接字符串所需的内存操作要慢得多。' 记住这是⽰范代码，⽽不是产品代码。'
' 2) 使⽤了 \"Option Explicit\"，因为访问声明过的变量，⽐访问未声明的变量要' 稍微快⼀些。它还能阻⽌在代码中发⽣错误，例如，把 DriveTypeCDROM 误拼' 成了 DriveTypeCDORM 。'
' 3) 为了使代码更可读，该代码中没有错误处理。虽然采取了防范措施，来保证代码' 在普通情况下没有错误，但⽂件系统是不可预知的。在产品代码中，使⽤
' On Error Resume Next 和 Err 对象来捕获可能发⽣的错误。''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ⼀些容易取得的全局变量'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim TabStopDim NewLineConst TestDrive = \"C\"Const TestFilePath = \"C:\\Test\"'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 由 Drive.DriveType 返回的常数'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Const DriveTypeRemovable = 1Const DriveTypeFixed = 2Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4Const DriveTypeRAMDisk = 5'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 由 File.Attributes 返回的常数'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Const FileAttrNormal = 0Const FileAttrReadOnly = 1Const FileAttrHidden = 2Const FileAttrSystem = 4Const FileAttrVolume = 8Const FileAttrDirectory = 16Const FileAttrArchive = 32Const FileAttrAlias = 64
Const FileAttrCompressed = 128'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ⽤来打开⽂件的常数'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Const OpenFileForReading = 1Const OpenFileForWriting = 2Const OpenFileForAppending = 8'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowDriveType'' ⽬的：'
' ⽣成⼀个字符串，来描述给定 Drive 对象的驱动器类型。'' ⽰范下⾯的内容'
' - Drive.DriveType'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Function ShowDriveType(Drive)Dim S
Select Case Drive.DriveTypeCase DriveTypeRemovableS = \"Removable\"Case DriveTypeFixedS = \"Fixed\"
Case DriveTypeNetworkS = \"Network\"
Case DriveTypeCDROMS = \"CD-ROM\"
Case DriveTypeRAMDiskS = \"RAM Disk\"Case ElseS = \"Unknown\"End Select
ShowDriveType = SEnd Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShowFileAttr'' ⽬的：'
' ⽣成⼀个字符串，来描述⽂件或⽂件夹的属性。'
' ⽰范下⾯的内容'
' - File.Attributes' - Folder.Attributes'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''2006-02-28 22:37回复
举报 |
drawing101初级粉丝1 7楼
Function ShowFileAttr(File) ' File 可以是⽂件或⽂件夹Dim SDim Attr
Attr = File.AttributesIf Attr = 0 Then
ShowFileAttr = \"Normal\"Exit FunctionEnd If
If Attr And FileAttrDirectory Then S = S & \"Directory \" If Attr And FileAttrReadOnly Then S = S & \"Read-Only \"If Attr And FileAttrHidden Then S = S & \"Hidden \"If Attr And FileAttrSystem Then S = S & \"System \"If Attr And FileAttrVolume Then S = S & \"Volume \"If Attr And FileAttrArchive Then S = S & \"Archive \"If Attr And FileAttrAlias Then S = S & \"Alias \"
If Attr And FileAttrCompressed Then S = S & \"Compressed \" ShowFileAttr = SEnd Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateDriveInformation'' ⽬的：'
' ⽣成⼀个字符串，来描述可⽤驱动器的当前状态。'
' ⽰范下⾯的内容'
' - FileSystemObject.Drives' - Iterating the Drives collection
' - Drives.Count' - Drive.AvailableSpace' - Drive.DriveLetter' - Drive.DriveType' - Drive.FileSystem' - Drive.FreeSpace' - Drive.IsReady' - Drive.Path
' - Drive.SerialNumber' - Drive.ShareName' - Drive.TotalSize' - Drive.VolumeName'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateDriveInformation(FSO)Dim DrivesDim DriveDim S
Set Drives = FSO.Drives
S = \"Number of drives:\" & TabStop & Drives.Count & NewLine & NewLi ne' 构造报告的第⼀⾏。
S = S & String(2, TabStop) & \"Drive\"S = S & String(3, TabStop) & \"File\"S = S & TabStop & \"Total\"S = S & TabStop & \"Free\"S = S & TabStop & \"Available\"S = S & TabStop & \"Serial\" & NewLine' 构造报告的第⼆⾏。S = S & \"Letter\"
S = S & TabStop & \"Path\"S = S & TabStop & \"Type\"S = S & TabStop & \"Ready?\"S = S & TabStop & \"Name\"S = S & TabStop & \"System\"S = S & TabStop & \"Space\"
S = S & TabStop & \"Space\"S = S & TabStop & \"Space\"
S = S & TabStop & \"Number\" & NewLine' 分隔⾏。
S = S & String(105, \"-\") & NewLineFor Each Drive In DrivesS = S & Drive.DriveLetterS = S & TabStop & Drive.Path
S = S & TabStop & ShowDriveType(Drive)S = S & TabStop & Drive.IsReadyIf Drive.IsReady Then
If DriveTypeNetwork = Drive.DriveType ThenS = S & TabStop & Drive.ShareNameElse
S = S & TabStop & Drive.VolumeNameEnd If
S = S & TabStop & Drive.FileSystemS = S & TabStop & Drive.TotalSizeS = S & TabStop & Drive.FreeSpaceS = S & TabStop & Drive.AvailableSpaceS = S & TabStop & Hex(Drive.SerialNumber)End If
S = S & NewLineNext
GenerateDriveInformation = SEnd Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GenerateFileInformation'' ⽬的：'
' ⽣成⼀个字符串，来描述⽂件的当前状态。'
' ⽰范下⾯的内容
'
' - File.Path
' - http://www.doczj.com/doc/35df812e647d27284b735158.html' - File.Type' - File.DateCreated' - File.DateLastAccessed' - File.DateLastModified' - File.Size'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Function GenerateFileInformation(File)Dim S
S = NewLine & \"Path:\" & TabStop & File.Path
S = S & NewLine & \"Name:\" & TabStop & http://www.doczj.com/doc/35df812e647d27284b735158.html
因篇幅问题不能全部显示，请点此查看更多更全内容