月度归档： 2024 年 7 月

‘绑定 AutoCAD
Dim I As Integer, J As Integer
Dim oAutoCAD As Object
Call BindAutoCAD(True)

‘打开并绑定文件 D:/Test.dwg
Dim oDraw As Object ‘AutoCAD 多文档之一
Set oDraw = oAutoCAD.Application.Documents.Open(“D:/Test.dwg”)

‘spline 起止点切向
Dim StartTan(0 To 2) As Double
Dim EndTan(0 To 2) As Double
StartTan(0) = 0#
StartTan(1) = 0#
StartTan(2) = 0#
EndTan(0) = 0#
EndTan(1) = 0#
EndTan(2) = 0#
‘FitPoints 赋值
ReDim FitPoints(0 To 14) As Double ‘5 个拟合点
FitPoints(0) = 1
FitPoints(1) = 2
FitPoints(2) = 0
FitPoints(3) = 4
FitPoints(4) = 5
FitPoints(5) = 0
FitPoints(6) = 7
FitPoints(7) = 8
FitPoints(8) = 0
FitPoints(9) = 12
FitPoints(10) = 2
FitPoints(11) = 0
FitPoints(12) = 19
FitPoints(13) = -4
FitPoints(14) = 0
‘creates a spline Object in model space
Set oSpline = oDraw.ModelSpace.AddSpline(FitPoints, StartTan, EndTan)
oSpline.Color = 1 ‘Red

‘ 利用初始化文件读写信息
lRet = WriteIniFile(“General”, “Name”, “wyrcad”, “D:\Test.ini”)
lRet = WriteIniFile(“General”, “Age”, “36”, “D:\Test.ini”)
sRet = ReadIniFile(“General”, “Name”, “D:\Test.ini”)
Debug.Print sRet
sRet = ReadIniFile(“General”, “Age”, “D:\Test.ini”)
Debug.Print sRet

‘ 利用注册表读写信息
Call SaveString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “wyrcad”, “General”, “D:\Test.ini”)
Call SaveString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “36”, “General”, “D:\Test.ini”)
sRet = GetString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “General”, “D:\Test.ini”)
Debug.Print sRet
sRet = GetString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “General”, “D:\Test.ini”)
Debug.Print sRet

‘ 删除注册表或初始化文件信息
DelSetting HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “General”, “D:\Test.ini”
DelSetting HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “General”, “D:\Test.ini”

Public Function GetExeVersion(ByVal sFullName As String) As String ‘获取可执行文件版本号
Dim FSO As Object
GetExeVersion = “”
If Not FileExist(sFullName) Then Exit Function
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetExeVersion = FSO.GetFileVersion(sFullName)
Set FSO = Nothing
End Function

Public Function GetExeInfo(ByVal sFullName As String) As String ‘获取可执行文件的信息
Dim FSO As Object
GetExeInfo = “”
If Not FileExist(sFullName) Then Exit Function
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFile As Object
Set oFile = FSO.GetFile(sFullName)
GetExeInfo = oFile.Size ‘Type/Attributes/Name/Path .etc
Set FSO = Nothing
End Function

Public Function GetWindows() As String ‘获取 Windows
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetWindows = FSO.GetSpecialFolder(0)
Set FSO = Nothing
End Function

Public Function GetSystem() As String ‘获取 System
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetSystem = FSO.GetSpecialFolder(1)
Set FSO = Nothing
End Function

Public Function GetTemporary() As String ‘获取 Temporary
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetTemporary = FSO.GetSpecialFolder(2)
Set FSO = Nothing
End Function

Public Function GetFileList(ByVal sFolder As String) As String ‘获取文件夹本级内所有文件
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFolder As Object, oItem As Object, oCollection As Object
Dim sList As String
If FSO.FolderExists(sFolder) Then
Set oFolder = FSO.GetFolder(sFolder)
Set oCollection = oFolder.Files
‘Debug.Print oCollection.Count
For Each oItem In oCollection
sList = sList & oItem.Name
sList = sList & “|”
Next
GetFileList = sList
Else
GetFileList = “”
End If
Set FSO = Nothing
End Function

Public Function GetFolderList(ByVal sFolder As String) As String ‘获取文件夹下一级所有子文件夹
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFolder As Object, oItem As Object, oCollection As Object
Dim sList As String
If FSO.FolderExists(sFolder) Then
Set oFolder = FSO.GetFolder(sFolder)
Set oCollection = oFolder.SubFolders
‘Debug.Print oCollection.Count
For Each oItem In oCollection
sList = sList & oItem.Name
sList = sList & “|”
Next
GetFolderList = sList
Else
GetFolderList = “”
End If
Set FSO = Nothing
End Function

Public Function GetDrivesList() As String
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oItem As Object, oCollection As Object
Dim sList As String
Set oCollection = FSO.Drives
For Each oItem In oCollection
‘Debug.Print oItem.SerialNumber
sList = sList & oItem.DriveLetter
sList = sList & “|”
Next
GetDrivesList = sList
Set FSO = Nothing
End Function