作者： 老王

Option Explicit
Public Const BUFFER = 256
Public Declare Function GetProfileInt Lib “kernel32” Alias “GetProfileIntA” (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long) As Long
Public Declare Function GetProfileSection Lib “kernel32” Alias “GetProfileSectionA” (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Public Declare Function GetProfileString Lib “kernel32” Alias “GetProfileStringA” (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Public Declare Function GetPrivateProfileInt Lib “kernel32” Alias “GetPrivateProfileIntA” (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileSection Lib “kernel32” Alias “GetPrivateProfileSectionA” (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib “kernel32” Alias “GetPrivateProfileStringA” (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WriteProfileSection Lib “kernel32” Alias “WriteProfileSectionA” (ByVal lpAppName As String, ByVal lpString As String) As Long
Public Declare Function WriteProfileString Lib “kernel32” Alias “WriteProfileStringA” (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Public Declare Function WritePrivateProfileSection Lib “kernel32” Alias “WritePrivateProfileSectionA” (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib “kernel32” Alias “WritePrivateProfileStringA” (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Function WriteIniFile(ByVal sApp As String, ByVal sKey As String, ByVal sData As String, ByVal sIniFile As String) As Long
WriteIniFile = WritePrivateProfileString(sApp, sKey, sData, sIniFile)
End Function

Public Function ReadIniFile(ByVal sApp As String, ByVal sKey As String, ByVal sIniFile As String) As String
Dim sBuffer As String
sBuffer = Space$(BUFFER)
If GetPrivateProfileString(sApp, sKey, “”, sBuffer, BUFFER, sIniFile) > 0 Then
ReadIniFile = GetAPIString(sBuffer)
Else
ReadIniFile = “”
End If
End Function

‘绑定 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”)

‘插入表格
Dim oTable As Object
Dim dInsertPoint(2) As Double
dInsertPoint(0) = 12
dInsertPoint(1) = 12
dInsertPoint(2) = 0
Set oTable = oDraw.ModelSpace.AddTable(dInsertPoint, 6, 7, 10, 50) ‘插入点,行列数,单元格高宽

‘调整字体
Call AddTextStyle(“Standard”)

‘填充表格
oTable.SetText 0, 0, “LOAD LIST”

oTable.SetText 1, 0, “Load”
oTable.SetText 2, 0, “Rating(kW)”
oTable.SetText 3, 0, “Factor”
oTable.SetText 4, 0, “Voltage(kV)”
oTable.SetText 5, 0, “Current(A)”

oTable.SetText 1, 1, “潜污泵 A”
oTable.SetText 2, 1, “22”
oTable.SetText 3, 1, “0.8”
oTable.SetText 4, 1, “0.38”
oTable.SetText 5, 1, “=B3/(1.732×B4×B5)” ‘× 改为合法的六星乘号

oTable.SetText 1, 2, “循环泵”
oTable.SetText 2, 2, “37”
oTable.SetText 3, 2, “0.8”
oTable.SetText 4, 2, “0.38”
oTable.SetText 5, 2, “=C3/(1.732×C4×C5)” ‘× 改为合法的六星乘号

oTable.SetText 1, 3, “外输泵”
oTable.SetText 2, 3, “45”
oTable.SetText 3, 3, “0.8”
oTable.SetText 4, 3, “0.38”
oTable.SetText 5, 3, “=D3/(1.732×D4×D5)” ‘× 改为合法的六星乘号

oTable.SetText 1, 4, “管道泵”
oTable.SetText 2, 4, “18.5”
oTable.SetText 3, 4, “0.8”
oTable.SetText 4, 4, “0.38”
oTable.SetText 5, 4, “=E3/(1.732×E4×E5)” ‘× 改为合法的六星乘号

oTable.SetText 1, 5, “潜污泵 B”
oTable.SetText 2, 5, “22”
oTable.SetText 3, 5, “0.8”
oTable.SetText 4, 5, “0.38”
oTable.SetText 5, 5, “=F3/(1.732×F4×F5)” ‘× 改为合法的六星乘号

oTable.SetText 1, 6, “照明箱”
oTable.SetText 2, 6, “20”
oTable.SetText 3, 6, “0.8”
oTable.SetText 4, 6, “0.38”
oTable.SetText 5, 6, “=G3/(1.732×G4×G5)” ‘× 改为合法的六星乘号

‘获取第4行第5列的文字
Debug.Print oTable.GetText(3, 4) ‘单元格序号基于 0

‘绑定 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”)

‘ 生成块定义
Dim oBlockDef As Object
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set oBlockDef = oDraw.Blocks.Add(insertionPnt, “TestBlock”)

‘ 块内添加圆
Dim oCircle As Object
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 0: center(1) = 0: center(2) = 0
radius = 12
Set oCircle = oBlockDef.AddCircle(center, radius)
Debug.Print “Entity Name: ” & oCircle.EntityName
Debug.Print oCircle.Handle

‘ 块内添加单行文字
Dim startPoint(0 To 2) As Double
Dim height As Double
Dim textString As String
Dim oText As Object
startPoint(0) = 15
startPoint(1) = 5
startPoint(2) = 0
height = 6
textString = “A block demo.”
Set oText = oBlockDef.AddText(textString, startPoint, height)
Debug.Print “Entity Name: ” & oText.EntityName
Debug.Print oText.Handle

‘ 插入块(块的实例化)
Dim oBlockRef As Object
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set oBlockRef = oDraw.ModelSpace.InsertBlock(insertionPnt, “TestBlock”, 1#, 1#, 1#, 0)

‘ 缩放块实例
Dim basePoint(0 To 2) As Double
Dim scaleFactor As Double
basePoint(0) = 0#
basePoint(1) = 0#
basePoint(2) = 0#
scaleFactor = 10#
Call oBlockRef.ScaleEntity(basePoint, scaleFactor)

‘ 旋转块实例
Dim rotationAngle As Double
basePoint(0) = 0#
basePoint(1) = 0#
basePoint(2) = 0#
rotationAngle = 1.57 ‘弧度
Call oBlockRef.Rotate(basePoint, rotationAngle)

‘ 分解块实例
Dim oSet As Variant
oSet = oBlockRef.Explode()
For I = LBound(oSet) To UBound(oSet)
Debug.Print “Entity Name: ” & oSet(I).EntityName
Debug.Print oSet(I).Handle
Next

‘ 执行 AutoCAD 命令 Zoomextents
oAutoCAD.Zoomextents