VB+类模块CLS+SelectionSets的应用
Dim xlsMdb As New XlsMdbTxtDataDim 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
Sub LS()
Dim rr As AcadSelectionSet
Dim objText As AcadText
fType = Array("0"): fData = Array("Text")
Set rr = ReturnAllSelectSet(fType, fData)
For ii = 0 To rr.Count - 1
Select Case rr.Item(ii).ObjectName
Case "AcDbText"
Set objText = rr.Item(ii)
With objText
Debug.Print .TextString
End With
End Select
Next ii
End Sub
Function ReturnAllSelectSet(fTypeArray As Variant, fDataArray As Variant) As AcadSelectionSet
Dim appAutoCad 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
页:
[1]