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