Тема: Как записать найденные результаты в переменные?
Доброе утро всем!!!
В этом примере Кулик Алексей очень помог мне с поиском блоков и принадлежащих к ним атрибутов.
Результататы выводятся на MsgBox.
Помогите пожалуйста доработать код чтобы он записывал найденные результаты в переменные.
Схема должна быть такой:
1) Код работает и находит все блоки с атрибутами
2)Затем идет проверка найденных блоков
3)Если имя блока совпадает с желаемым первым блоком, то количество этих блоков заносится в переменную n1
4)Значение первого атрибута записываются в переменную k1
5)Значение второго атрибута записываются в переменную p1
6)Значение первого атрибута записываются в переменную t1
и т.д.
7)Далее все повторяется с 2 пункта. Если имя блока совпадает с желаемым ВТОРЫМ блоком, то количество этих блоков заносится в переменную n2
И Т.Д.
Option Explicit
Dim EffectiveNameAvailable As Boolean
Private Sub fun_ClearSelectionSetByName(sName As String)
Dim lCounter As Long
On Error Resume Next
With ThisDrawing.SelectionSets
For lCounter = 0 To .SelectionSets.count
If UCase(.Item(lCounter).Name) Like UCase(sName) Then
.Item(lCounter).Clear
.Item(lCounter).Delete
End If
Next
End With
End Sub
Function fun_GetBlockName(objBlockRef As AcadBlockReference) As String
If EffectiveNameAvailable Then
fun_GetBlockName = objBlockRef.EffectiveName
Else
fun_GetBlockName = objBlockRef.Name
End If
End Function
Sub GetBlockattr()
EffectiveNameAvailable = CInt(Left(ThisDrawing.GetVariable("acadver"), _
2)) >= 16
Dim objBlock As AcadBlock, objBlockRef As AcadBlockReference, _
objAttr As AcadAttribute
Dim SelSet As AcadSelectionSet
Dim fType(1) As Integer, fData(1) As Variant
Dim sAttr As String, sTmpAttr As String, arAttr() As AcadAttributeReference
fType(0) = 0: fData(0) = "INSERT"
fType(1) = 66: fData(1) = 1
Dim sSelSetName As String
sSelSetName = "SelectionForGetBlockAttr"
fun_ClearSelectionSetByName sSelSetName
On Error GoTo lErrorSelect
Set SelSet = ThisDrawing.SelectionSets.Add(sSelSetName)
SelSet.SelectOnScreen fType, fData
Dim objSelSet As AcadEntity, lCounter As Long
For Each objBlockRef In SelSet
If sAttr = "" Then
sAttr = "Имя опоры" & " - " & fun_GetBlockName(objBlockRef)
Else
sAttr = sAttr & vbCr & "Имя опоры" & " - " & fun_GetBlockName(objBlockRef)
End If
arAttr = objBlockRef.GetAttributes
For lCounter = 0 To UBound(arAttr)
sAttr = sAttr & vbCr & arAttr(lCounter).TagString & " - " & arAttr(lCounter).TextString
Next 'lCounter
Next 'objBlockRef
MsgBox sAttr
Exit Sub
lErrorSelect:
MsgBox "Ничего не выбрано"
fun_ClearSelectionSetByName sSelSetName
Exit Sub
End Sub
