|
|
Dim xlsMdb As New XlsMdbTxtData
Dim CadEnt As New AcadEntity
'主程序
Private Sub Form_Load()
Dim ojbLine As AcadLine
Dim pp(0 To 2) As Double, ppp(0 To 2) As Double
Dim xlSheet1 As Worksheet
Set xlSheet1 = xlsMdb.ReturnxlSheet("Sheet1")
Dim objText As AcadText, objTextSelectSet As AcadSelectionSet
Dim fTypa As Variant, fData As Variant
fType = Array("0"): fData = Array("Text")
Set objTextSelectSet = CadEnt.ReturnAllSelectSet(fType, fData)
Debug.Print objTextSelectSet.Count
For ii = 0 To objTextSelectSet.Count - 1
Set objText = objTextSelectSet.Item(ii)
xlSheet1.Cells(ii + 1, 1) = objText.TextString
Next ii
End Sub
'类模块
Function ReturnAllSelectSet(fTypeArray As Variant, fDataArray As Variant) As AcadSelectionSet
Dim app As AutoCAD.AcadApplication
On Error Resume Next
Set appAutoCad = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set appAutoCad = CreateObject("AutoCAD.Application")
End If
appAutoCad.Visible = True
Dim AcadDoc As AcadDocument
Set AcadDoc = appAutoCad.ActiveDocument
''
Dim fType, fData
ReDim fType(0 To UBound(fTypeArray) + 2) As Integer
ReDim fData(0 To UBound(fDataArray) + 2) As Variant
fType(0) = -4
For ii = 0 To UBound(fTypeArray)
fType(ii + 1) = fTypeArray(ii)
Next ii
fType(UBound(fType)) = -4
''
fData(0) = ""
''
'选择过滤出图形中所有的标注对象
''
With AcadDoc
.SelectionSets("mccad").Delete
Set Sset = .SelectionSets.Add("mccad")
'建立过滤器
'选择过滤出图形中所有的标注对象
Sset.Select 5, , , fType, fData
Set ReturnAllSelectSet = Sset
End With
End Function
|
|
置顶卡
