dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA autocad 2016. Можно ли считывать/записывать данные из таблицы в массив одной операцией?

VBA autocad 2016. Можно ли считывать/записывать данные из таблицы в массив одной операцией?

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 27.12.2017, 15:30 #1
VBA autocad 2016. Можно ли считывать/записывать данные из таблицы в массив одной операцией?
AlexV
 
Инженер
 
С-Пб
Регистрация: 02.10.2008
Сообщений: 3,595

AlexV вне форума Вставить имя

Код:
[Выделить все]
Dim tb  As AcadTable, arr as variant, arr1(10,10)
Предположим, есть таблица tb 10 строк/10 столбцов. Данные из нее в массив собираю/записываю по ячейкам, перебирая в цикле arr1(i,j)= tb.GetCellValue(i, j). А нельзя ли это осуществлять в одну операцию (проверив, естественно, соответствие размерностей)?
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
Просмотров: 1174
 
Непрочитано 27.12.2017, 16:24
#2
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 1,659


Я так понимаю, Вы хотите что то типа .Cells.Range("A1", "C2") из Excel, но в COM автокада такого метода нет.
Могу предложить Вам написать свой метод/функцию... вызов будет одной строкой... =)
__________________
_бложиг
Boxa на форуме вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 27.12.2017, 16:40
#3
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,595


Цитата:
Сообщение от Boxa Посмотреть сообщение
Я так понимаю, Вы хотите что то типа .Cells.Range("A1", "C2") из Excel, но в COM автокада такого метода нет.
Могу предложить Вам написать свой метод/функцию... вызов будет одной строкой... =)
Ну, если имеется в виду запихать сию операцию в отдельную функцию в коде макроса vba, то нет проблем, так и делаю обычно..

...Что бы далеко не ходить и темы не плодить, хочу задать еще вопрос - тем более, он тож к таблицам отношение имеет..
С помощью вот такой функции я ловлю таблицы в коллекцию. Поковырявшись в dxf кодах таблиц через (entget (car (entsel))), смог задать выбор таблиц из файла по кол-ву строк/столбцов и текстовому значению одной из ячеек таблиц (то бишь, ловятся таблички с кол-вом строк/столбцов x, y и наличию в одной из ячеек текста "Вася" и "Федя"). А можно ли задать условие, что бы ловились те, где забито в ячейку хотя бы одно из значений?

Код:
[Выделить все]
Private Function SelectTable(str, x, y) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim nrow As Long, ncol As Long
Dim intType(4) As Integer
Dim varData(4) As Variant
nrow = CLng(x)
ncol = CLng(y)
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
 If objSelSet.Name = "123" Then
  objSelSet.Delete
  Exit For
 End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("123")
intType(0) = 0 '
varData(0) = "ACAD_TABLE" '
intType(1) = 91 '
varData(1) = nrow ' 
intType(2) = 92 '
varData(2) = ncol  ' 
intType(3) = 302 '
varData(3) = "Вася"'
intType(4) = 302 '
varData(4) = "Федя" '
If str = "Выбрать объекты" Then
  objSelSet.SelectOnScreen intType, varData
Else
  objSelSet.Select acSelectionSetAll, , , intType, varData
End If
Set SelectTable = objSelSet

'podsvetko
End Function

...А еще, нельзя ли в данном фильтре как-то обойти форматирование текста? А то если Васю сжать внутри ячейки, он уже, понимаешь, не "Вася", а "{\\W0.8;Вася}"..

...А еще, - как/возможно ли фильтровать не по значению одной из ячеек, - а по значению определенной ячейки (к примеру, tb.GetCellValue(2,2))?

...А еще - возможно ли задавать в фильтре для кол-ва строк-столбцов не точные значения, а диапазоны, списки или условия (к примеру, "nkol =10...15" ...или "nkol >=10" ... или "nrow= 1,5,8,9,666"?
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!

Последний раз редактировалось AlexV, 27.12.2017 в 17:10.
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 27.12.2017, 17:11
#4
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 577


Цитата:
Сообщение от AlexV Посмотреть сообщение
а "{\\W0.8;Вася}"
Васю можно и почистить. Закомментированы не нужные лично мне строки
Код:
[Выделить все]
Function UnformatMtext(S As String) As String

Dim P1 As Integer
Dim P2 As Integer, P3 As Integer
Dim intStart As Integer
Dim strCom As String
Dim strReplace As String

'Debug.Print S

Select Case Left(S, 4)
    Case "\A0;", "\A1;", "\A2;"
    S = Mid(S, P1 + 5)
End Select

intStart = 1
'Do
'    P1 = InStr(S, "%%")
'    If P1 = 0 Then
'        Exit Do
'    Else
'        Select Case Mid(S, P1 + 2, 1)
'            Case "P"
'                S = Replace(S, "%%P", "+or-")
'            Case "D"
'                S = Replace(S, "%%D", " deg")
'        End Select
'    End If
'Loop

Do
P1 = InStr(intStart, S, "\", vbTextCompare)
If P1 = 0 Then Exit Do
    strCom = Mid(S, P1, 2)
    Select Case strCom
        Case "\p"
            P2 = InStr(1, S, ";")
            S = Mid(S, P2 + 1)
        Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W"
            P2 = InStr(P1 + 2, S, ";", vbTextCompare)
            P3 = InStr(P1 + 2, S, strCom, vbTextCompare)
            If P3 = 0 Then
                S = Left(S, P1 - 1) & Mid(S, P2 + 1)
            End If
            Do While P3 > 0
                P2 = InStr(P3, S, ";", vbTextCompare)
                S = Left(S, P3 - 1) & Mid(S, P2 + 1)
                'Debug.Print s, strCom
                P3 = InStr(1, S, strCom, vbTextCompare)
            Loop
            's = Left(s, P3 - 1) & mid(s, P3 + 1)
        Case "\L", "\O"
            Dim strLittle As String
            strLittle = LCase(strCom)
            P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
            If P2 = 0 Then
                S = Left(S, P1 - 1) & Mid(S, P1 + 2)
            Else
                S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
            End If
        Case "\S"
            P2 = InStr(P1 + 2, S, ";", vbTextCompare)
            P3 = InStr(P1 + 2, S, "/", vbTextCompare)
            If P3 = 0 Or P3 > P2 Then
                P3 = InStr(P1 + 2, S, "#", vbTextCompare)
            End If
            If P3 = 0 Or P3 > P2 Then
                P3 = InStr(P1 + 2, S, "^", vbTextCompare)
            End If
            S = Left(S, P1 - 1) & Mid(S, P1 + 2, P3 - (P1 + 2)) _
            & "/" & Mid(S, P3 + 1, (P2) - (P3 + 1)) & Mid(S, P2 + 1)

        Case "\U"
            strLittle = Mid(S, P1 + 3, 4)
'            'Debug.Print strLittle
    Select Case strLittle
'        Case "2248"
'            strReplace = "ALMOST EQUAL"
'        Case "2220"
'            strReplace = "ANGLE"
'        Case "2104"
'            strReplace = "CENTER LINE"
'        Case "0394"
'            strReplace = "DELTA"
'        Case "0278"
'            strReplace = "ELECTRIC PHASE"
'        Case "E101"
'            strReplace = "FLOW LINE"
'        Case "2261"
'            strReplace = "IDENTITY"
'        Case "E200"
'            strReplace = "INITIAL LENGTH"
'        Case "E102"
'            strReplace = "MONUMENT LINE"
'        Case "2260"
'            strReplace = "NOT EQUAL"
'        Case "2126"
'            strReplace = "OHM"
'        Case "03A9"
'            strReplace = "OMEGA"
'        Case "214A"
'            strReplace = "PROPERTY LINE"
'        Case "2082"
'            strReplace = "SUBSCRIPT2"
'        Case "00B2"
'            strReplace = "SQUARED"
'        Case "00B3"
'            strReplace = "CUBED"

    End Select
S = Replace(S, "\U+" & strLittle, strReplace)

        Case "\~"
            S = Replace(S, "\~", " ")

        Case "\\"
            intStart = P1 + 2
            S = Replace(S, "\\", "\")
            GoTo Selectagain

        Case "\P"
            intStart = P1 + 1
            GoTo Selectagain
        Case Else
            Exit Do
        End Select
Selectagain:
            Loop

Do
P1 = InStr(1, S, "\P", vbTextCompare)
If P1 = 0 Then
    Exit Do
Else
    S = Left(S, P1 - 1) & vbCrLf & Mid(S, P1 + 2)
End If
Loop
For intStart = 0 To 1
    If intStart = 0 Then
        strCom = "}"
    Else
        strCom = "{"
    End If
    P2 = InStr(1, S, strCom)

    Do While P2 > 0
    S = Left(S, P2 - 1) & Mid(S, P2 + 1)
    P2 = InStr(1, S, strCom)
    Loop
Next intStart

UnformatMtext = S

End Function
kacugu вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 27.12.2017, 17:22
#5
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,595


Цитата:
Сообщение от kacugu Посмотреть сообщение
Васю можно и почистить. Закомментированы не нужные лично мне строки
За код спасибо, пригодится!
Но у меня не стоит задача убивать форматирование - как раз оно должно остаться прежним. Можно, конечно, найти таблицы с нужным кол-вом строк/столбцов, каждый экземпляр скопировать, копию отформатировать, проверить на соответствие и затем удалить.. Но тогда и необходимость в фильтре отпадет - можно тупо каждую таблицу поячеисто почесать..
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 27.12.2017, 17:31
#6
kacugu

начинающий инженер-гидротехник
 
Регистрация: 18.04.2010
Санкт-Петербург
Сообщений: 577


Цитата:
Сообщение от AlexV Посмотреть сообщение
убивать форматирование
не знаю как будет работать с таблица - я атрибуты блоков при импорте очищал от форматирования. Так при экспорте этих атрибутов обратно в Autocad форматирование сохранялось. Может и таблицами прокатит
kacugu вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA autocad 2016. Можно ли считывать/записывать данные из таблицы в массив одной операцией?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как в формулах одной таблицы сослаться на ячейки другой таблицы? МишаИнженер AutoCAD 27 22.01.2018 18:57
Перенести данные с таблицы AutoCad в Eccess Jeneva AutoCAD 2 23.06.2017 10:11
Проблема создания связи таблиц в AutoCAD 2016 с MS Excel 2016 alterfiesta AutoCAD 13 04.09.2016 12:11
Программное создание таблицы AutoCAD. Муки творчества. Do$ Программирование 46 03.08.2016 16:48
Какую версию ObjectARX с каким AutoCAD можно можно использовать? nav3000 Программирование 3 01.12.2012 21:37

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||