Перенос числовых данных из чертежа в программу

Julius · 31.10.2010, 14:36

Всем доброго времени суток.
Пишу макрос для автокада. Суть его в том, что пользователь выбирает щелчком мыши некоторые текстовые блоки (text и mtext) в которых содержаться числа. Затем, по окончанию выбора программа выдает сумму всех чисел в выбранных текстовых блоках.
Проблема в том, что я не знаю как присвоить переменной в программе значения числа в текстовом блоке (например, я выбираю на чертеже текстовый блок, в котором написано число 5 и некой переменной в программе присваивается значение 5).
Помогите, пожалуйста.
Заранее спасибо.

gomer · 31.10.2010, 15:05

Возможно вам поможет INCDEC

Кулик Алексей aka kpblc · 31.10.2010, 15:20

http://www.google.ru/cse?cx=partner-...7%23post647137

AlexV · 31.10.2010, 20:26

Julius, ну дак код-то уже есть какой-то или ты с нуля его хочешь получить? "макрос для автокада", - на VBA значит пишешь? Выбираешь программно тексты и мтексты, затем перебираешь полученный набор, проверяя свойство textstring.. Алгоритм получения суммы зависит от твоих задач: - что за тексты надо "собирать", - содержащие только числа, или все ( только "1", "2", "33", либо еще и "12АБВ", "12АБВ123" и т.д.). Для mtext надо наверное еще учитывать возможность наличич форматирования внутри него (т.е в нем может быть текст из цифр "111", но подчеркнутых-надчеркнутых-с другим шрифтом, цветом и т.д., тогда textstring может содержать к примеру значение "{\fCurlz MT|b0|i0|c0|p82;\C1;1111}", и искомые "111" надо еще отсюда выдернуть..

Julius · 31.10.2010, 21:33

Кулик Алексей, спасибо за полезную ссылку. Нашел программу, почти ту, что мне нужно. Поменял одну строку, вот что получилось:

Sub SummaMText()

Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim item As AcadMText
Dim Summa As Double

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen

For Each item In CirSet
Summa = Summa + CDbl(item.TextString)
Next item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

MsgBox Summa

End Sub

Но столкнулся с такой проблемой: когда я вставляю код в редакторе VBA в окно "Thisdrawing", то все работает отлично. А когда я создал форму и повесил этот же код на нажатие кнопки, то автокад стал выдавать ошибку "Главное окно AutoCAD невидимо" и и показывает, что ошибка в строке

CirSet.SelectOnScreen

Кто знает в чем причина? Подскажите.

AlexV · 31.10.2010, 21:52

Цитата:

Сообщение от Julius

Код я пишу с нуля на VBA. Что касается текстов, то тут все довольно просто - это будут числа типа "100", "2300" и т.д.

Ну дак выложи, чего написал-то уже.. В чем затрудненья?

Julius · 31.10.2010, 22:27

Цитата:

Сообщение от AlexV

Ну дак выложи, чего написал-то уже.. В чем затрудненья?

Вот выложил. Смотрите предыдущее сообщение

AlexV · 31.10.2010, 22:42

Цитата:

Сообщение от Julius

Но столкнулся с такой проблемой: когда я вставляю код в редакторе VBA в окно "Thisdrawing", то все работает отлично. А когда я создал форму и повесил этот же код на нажатие кнопки, то автокад стал выдавать ошибку "Главное окно AutoCAD невидимо" и и показывает, что ошибка в строке
CirSet.SelectOnScreen
Кто знает в чем причина? Подскажите.

Потому что форма по умолчанию модальная. Соответственно, когда она запущена, главное окно автокада и "не видимо", поэтому при попытке выбора объектов выдается ошибка. Надо либо сделать форму немодальной (свойство ShowModal в окне свойств формы = false), либо в начале процедуры по нажатию кнопки скрывать форму UserForm1.Hide; по окончании процедуры снова выводить на экран UserForm1.Show. В первом случае (если форма будет немодальной) невозможно будет вводить текст с клавиатуры в textbox-ы и другие подобные контролы формы.

gomer · 31.10.2010, 22:50

Если еще и очистить набор, все получится

AlexV · 31.10.2010, 23:05

Ну и еще, если исходить из кода в #5, еще несколько замечаний.. SelectOnScreen производится без фильтра, а переменная item объявляется As AcadMText. Если пользователь выберет любой другой примитив (даже AcadText, который вроде тоже должен учитываться), то в цикле выскочит ошибка. Ну, это конечно легко лечится вставкой в начале кода строки "On Error Resume Next", но грамотней использовать фильтры.. Чего-то типа такого:

Код:

[Выделить все]

'....
Dim intType(3) As Integer
Dim varData(3) As Variant
intType(0) = -4
varData(0) = "<OR"
intType(1) = 0
varData(1) = "MTEXT"
intType(2) = 0
varData(2) = "TEXT"
intType(3) = -4
varData(3) = "OR>"
'....
CirSet.SelectOnScreen intType, varData

А еще, строка
Set CirSet = SelSetColl.Add("Mt")
Если в файле вдруг уже есть набор с именем "Mt", тоже выскочит ошибка.. Можно перед этой строкой проверить:

Код:

[Выделить все]

For Each CirSet In ThisDrawing.SelectionSets
 If CirSet.name =  "Mt" Then
    CirSet.Delete
    Exit For
 End If
Next

Julius · 01.11.2010, 23:19

Учел Ваши замечания. Теперь код работает в рамках формы тоже. Однако работает только с Mtext. Когда появляется однострочный текст, то выдает ошибку в строке "For Each item In CirSet"

Код:

[Выделить все]

Private Sub CommandButton1_Click()

Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim item As AcadMText
Dim Summa As Double
Dim intType(3) As Integer
Dim varData(3) As Variant

intType(0) = -4
varData(0) = "<OR"
intType(1) = 0
varData(1) = "MTEXT"
intType(2) = 0
varData(2) = "TEXT"
intType(3) = -4
varData(3) = "OR>"

For Each CirSet In ThisDrawing.SelectionSets
 If CirSet.Name = "Mt" Then
    CirSet.Delete
    Exit For
 End If
Next

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen intType, varData


For Each item In CirSet
Summa = Summa + CDbl(item.TextString)
Next item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

MsgBox Summa

End Sub

Кулик Алексей aka kpblc · 01.11.2010, 23:39

Почему item объявлен как AcadMText, а не как AcadEntity?

Julius · 02.11.2010, 00:14

Цитата:

Сообщение от Кулик Алексей aka kpblc

Почему item объявлен как AcadMText, а не как AcadEntity?

Точно! Проглядел.
Теперь все работает. Спасибо.

scad2015 · 25.04.2015, 17:16

Подскажите, а если складывать десятичные числа с дробной точкой вылетает ошибка "Type mismatch", что делать?
-------------------------------------------------------------------

Решил так, заменил строчку (проблема была с десятичной точкой):

Summa = Summa + Val(item.TextString)

Кулик Алексей aka kpblc · 25.04.2015, 17:33

scad2015, ты не ошибся темой или разделом? Если нет, то на какой вопрос отвечал? И почему в таком случае не использовал "Цитировать" или "Цитировать выделенное"?

scad2015 · 25.04.2015, 19:35

Offtop: Я все понял, о чем ты. Я имел ввиду изначально, что эта программа не работает корректно. (может потому что у меня х64)
Я не с потолка вопрос задал.

Цитата:

Сообщение от Кулик Алексей aka kpblc

scad2015, ты не ошибся темой или разделом? Если нет, то на какой вопрос отвечал? И почему в таком случае не использовал "Цитировать" или "Цитировать выделенное"?

Offtop: Теперь использую цитирование

Я решил доработать этот пример, умножить несколько чисел и вставить в другой текст, и сделать все это в цикле , поэтому решил писать сюда. Может доработанный код многим пригодится.

Создать новую тему?
----------------------------

1) Проблема не решилась, при использовании Val. Теперь при перемножении чисел с разделителем дробной части запятой, отбрасывается дробная часть.
Может в VBA есть что-то типа Parse?

2) Как реализовать не бесконечный цикл Do Loop , пробовал отловить завершение через GetInput, но ничего не получилось, почитал по форумам, но ничего толкового не нашел.

Код кривой, но выкладываю как есть, надеюсь на помощь.

Код:

[Выделить все]

Sub Umnogenie()

'On Error Resume Next

Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim item As AcadEntity
Dim Summa As Double
Dim intType(3) As Integer
Dim varData(3) As Variant

intType(0) = -4
varData(0) = "<OR"
intType(1) = 0
varData(1) = "MTEXT"
intType(2) = 0
varData(2) = "TEXT"
intType(3) = -4
varData(3) = "OR>"

Do

For Each CirSet In ThisDrawing.SelectionSets
 If CirSet.Name = "Mt" Then
    CirSet.Delete
    Exit For
 End If
Next

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen intType, varData


For Each item In CirSet


If Summa = 0 Then
Summa = 1
End If

Summa = Summa * Val(item.TextString)

Next item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

'-----------Вставка текста ---------------------
ThisDrawing.Utility.Prompt "Выберите текст для вставки:"

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen intType, varData


For Each item In CirSet
item.TextString = Summa
Next item


'-----------------------------------------------------
ThisDrawing.Utility.Prompt Summa

Summa = 0

Loop 'While Err.Number <> 0

End Sub

Кулик Алексей aka kpblc · 25.04.2015, 21:59

Используй Replace, в чем проблема-то?

scad2015 · 27.04.2015, 18:44

Кулик Алексей aka kpblc,
Ничего по Replace не нашел смотрел справке по объектной модели, в справки по VB смотрел мельком.

Подскажи, пожалуйста примером кода.

Offtop: Я VB6 уже давно не пользовался, подзабыл уже

gomer · 27.04.2015, 20:01

Цитата:

Сообщение от scad2015

Ничего по Replace не нашел смотрел справке по объектной модели,

Replace - стандартная функция VBA, ищи в справке по VBA ее

scad2015 · 29.04.2015, 17:43

gomer, спасибо, замотался нет времени сесть разобраться. Но do loop плохой вариант, нашел несколько вариантом кода, но все через костыли какие-то.

Не понимаю, почему так сделано , что цикл вешает автокад....

Кулик Алексей aka kpblc · 30.04.2015, 00:31

Это не цикл вешает AutoCAD, а неверное построение алгоритма. Вот решение, нарисованное на коленке и без какой бы то ни было оптимизации:

Код:

[Выделить все]

Option Explicit

Public Sub MultiplyText()
Dim intType(0) As Integer
Dim varData(0) As Variant
Dim dRes As Double, dValue As Double
Dim objEnt As AcadEntity
Dim objText As AcadText, objMText As AcadMText
intType(0) = 0: varData(0) = "MTEXT,TEXT"

Dim ssName As String
Dim ssCur As AcadSelectionSet

  ssName = "dwgRuTextSelSet"
Do
On Error Resume Next
  ThisDrawing.SelectionSets(ssName).Delete
  Set ssCur = ThisDrawing.SelectionSets.Add(ssName)
On Error GoTo lErrorSelect
  ssCur.SelectOnScreen intType, varData
  dRes = 1: dValue = 0
  If ssCur.Count > 0 Then
    For Each objEnt In ssCur
      If objEnt.ObjectName = "AcDbText" Then
        Set objText = objEnt
        dValue = CDbl(Replace(Trim(objText.TextString), ".", ","))
      ElseIf objEnt.ObjectName = "AcDbMText" Then
        Set objMText = objEnt
        dValue = CDbl(Replace(Trim(objMText.TextString), ".", ","))
      End If
      If dValue <> 0 Then
        dRes = dRes * dValue
      End If
    Next
    ' Умножение построено. Теперь выводить...
    MsgBox "Res = " & CStr(dRes), vbOKOnly + vbInformation + vbApplicationModal
  Else
    GoTo lErrorSelect
  End If
Loop
  Exit Sub
lErrorSelect:
  MsgBox "Выбор прекращен", vbOKOnly + vbInformation + vbApplicationModal
End Sub

Тут можно и коллекции нарисовать, и массивы, и освобождать их по ходу дела - но мне лень.

scad2015 · 05.05.2015, 18:39

Цитата:

Сообщение от Julius

Summa = Summa + CDbl(item.TextString)

Я ничего не понимаю, эта строчка выдает Type mismatch, в чем проблема? Уже и так и сяк менял

gomer · 05.05.2015, 19:27

Цитата:

Сообщение от scad2015

Я ничего не понимаю, эта строчка выдает Type mismatch, в чем проблема? Уже и так и сяк менял

попробуй Val(), если не изменяет память

Кулик Алексей aka kpblc · 05.05.2015, 20:28

scad2015, во-первых: где чертеж? Во-вторых, у тебя разделителем целой и дробной частей установлена точка или запятая? Я проверял на ACAD2012 и 2013 (если мне не изменяет память) - у меня все работало в ожидаемом режиме.

scad2015 · 05.05.2015, 20:53

gomer, Кулик Алексей aka kpblc, Спасибо, разобрался.

Вся проблема именно в разделителе дробной части,
Offtop: который стоит в настройках в панели управления windows (региональные настройки - разделитель дробной части).

Val(item.TextString) - приводит числа только с десятичным разделителем точкой, если разделитель числа не точка, то он выдает значение до точки.

CDbl(item.TextString) - приводит числа с десятичным разделителем который установлен в системе.
//--------------------------------------------------------------------------

Решил сделать так: Summa = Summa + Val(Replace(item.TextString, ",", "."))

Теперь все работает =) ...и вроде без костылей...

В итоге:

Код:

[Выделить все]

Sub Summa()

Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim item As AcadEntity
Dim Summa As Double

For Each CirSet In ThisDrawing.SelectionSets
 If CirSet.Name = "Mt" Then
    CirSet.Delete
    Exit For
 End If
Next

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen


For Each item In CirSet
   If item.ObjectName = "AcDbMText" Or item.ObjectName = "AcDbText" Then
     Summa = Summa + Val(Replace(item.TextString, ",", "."))
   End If
Next item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

'-----------Вставка текста суммы---------------------
ThisDrawing.Utility.Prompt "Выберите текст для вставки:"

Set SelSetColl = ActiveDocument.SelectionSets
Set CirSet = SelSetColl.Add("Mt")
CirSet.SelectOnScreen


For Each item In CirSet
   If item.ObjectName = "AcDbMText" Or item.ObjectName = "AcDbText" Then
     item.TextString = Summa
   End If
Next item


Summa = 0

End Sub

Кулик Алексей aka kpblc, я балда такая, пост 21 пропустил, извиняюсь, там уже все написано было. Невнимательность моя..... Спасибо!

pekar83 · 15.01.2016, 11:38

подскажите пожалуста
идея почти таже самя
щёлкаем мыщью то текстовым блока и они выводятся в таблицу excel или в Autocad на этом же листе

Tom2k7 · 15.01.2016, 13:43

Цитата:

Сообщение от pekar83

щёлкаем мыщью то текстовым блока и они выводятся в таблицу excel или в Autocad на этом же листе

как раз набросал недавно себе для скорости код для сбора в таблицу autocad-а текстовых полей
сначала выбирается существующая таблица
затем текстовые поля
непустая таблица дополняется и расширяется по мере того как

Код:

[Выделить все]

Public Sub Text2Table()
    Dim pnt As Variant
    Dim Obj As AcadObject
    Dim Tabl As AcadTable
    Dim Txt As AcadText
    Dim MTxt As AcadMText
    Dim i As Integer
    
 
    On Error Resume Next
    
    ThisDrawing.Utility.GetEntity Obj, pnt, "Pick a Table"
    
    If Err = 0 Then
        If TypeOf Obj Is AcadTable Then
            Set Tabl = Obj
            i = 0
            While Tabl.GetText(i, 0) <> ""
                i = i + 1
            Wend
            Do
                Err.Clear
                ThisDrawing.Utility.GetEntity Obj, pnt, "Pick a Text"
                If Err <> 0 Then Exit Do
                If TypeOf Obj Is AcadText Then
                    Set Txt = Obj
                    If Tabl.Rows <= i Then Tabl.InsertRows i, Tabl.GetRowHeight(0), 1
                    Tabl.SetText i, 0, Txt.TextString
                    i = i + 1
                End If
                If TypeOf Obj Is AcadMText Then
                    Set MTxt = Obj
                    If Tabl.Rows <= i Then Tabl.InsertRows i, Tabl.GetRowHeight(0), 1
                    Tabl.SetText i, 0, MTxt.TextString
                    i = i + 1
                End If

            Loop While True
        Else
            MsgBox "not table selected"
        End If
    Else
        Err.Clear
        MsgBox "nothing selected"
    End If
    On Error GoTo 0
End Sub

pekar83 · 16.01.2016, 04:07

спасибо большое сейчас буду пробовать
для это надо устанвливать https://knowledge.autodesk.com/suppo...odule-vba.html

pekar83 · 16.01.2016, 05:19

Цитата:

сначала выбирается существующая таблица

как выбрить существующюю таблицу
это какая таблица? внутри чертежа или xls

Кулик Алексей aka kpblc · 16.01.2016, 10:41

Offtop:

Цитата:

Сообщение от pekar83

как выбрить существующюю таблицу

Чего с ней сделать? Выбрить?

pekar83 · 16.01.2016, 15:57

подскажите как пользоваться
как выбирать таблицу
Autocad таблицу просит но как как выбрать не могу

Tom2k7 · 19.01.2016, 11:53

да, надо выбрать существующую таблицу акада
это сделано чтобы можно было дописывать в одну и ту же таблицу, если понадобится
таблицу, понятно, надо просто создать в акаде

pekar83 · 20.01.2016, 11:28

можно ли как нибуть дописать чтобы
разные числа слова выводились в первый столбик таблицы
а числа с % во второй столбик
спасибо

Tom2k7 · 20.01.2016, 14:59

ну примерно так
теперь таблица должна быть из двух столбцов

Код:

[Выделить все]

Public Sub Text2Table2()
    Dim pnt As Variant
    Dim Obj As AcadObject
    Dim Tabl As AcadTable
    Dim Txt As AcadText
    Dim MTxt As AcadMText
    Dim i, j As Integer
    Dim s As String
 
    On Error Resume Next
    
    ThisDrawing.Utility.GetEntity Obj, pnt, "Pick a Table"
    
    If Err = 0 Then
        If TypeOf Obj Is AcadTable Then
            Set Tabl = Obj
            i = 0
            j = 0
            While Tabl.GetText(i, 0) <> ""
                i = i + 1
            Wend
            While Tabl.GetText(j, 1) <> ""
                j = j + 1
            Wend
            Do
                Err.Clear
                ThisDrawing.Utility.GetEntity Obj, pnt, "Pick a Text"
                If Err <> 0 Then Exit Do
                s = ""
                If TypeOf Obj Is AcadText Then
                    Set Txt = Obj
                    s = Txt.TextString
                End If
                If TypeOf Obj Is AcadMText Then
                    Set MTxt = Obj
                    s = MTxt.TextString
                End If
                If s > "" Then
                    If InStr(s, "%") = 0 Then
                        If Tabl.Rows <= i Then Tabl.InsertRows i, Tabl.GetRowHeight(0), 1
                        Tabl.SetText i, 0, s
                        i = i + 1
                    Else
                        If Tabl.Rows <= j Then Tabl.InsertRows j, Tabl.GetRowHeight(0), 1
                        Tabl.SetText j, 1, s
                        j = j + 1
                    End If
                End If
            Loop While True
        Else
            MsgBox "not table selected"
        End If
    Else
        Err.Clear
        MsgBox "nothing selected"
    End If
    On Error GoTo 0
End Sub

pekar83 · 21.01.2016, 04:55

огромное спасибо всё работет

31.10.2010, 14:36		#1
Перенос числовых данных из чертежа в программу Julius Регистрация: 30.10.2010 Сообщений: 5 Всем доброго времени суток. Пишу макрос для автокада. Суть его в том, что пользователь выбирает щелчком мыши некоторые текстовые блоки (text и mtext) в которых содержаться числа. Затем, по окончанию выбора программа выдает сумму всех чисел в выбранных текстовых блоках. Проблема в том, что я не знаю как присвоить переменной в программе значения числа в текстовом блоке (например, я выбираю на чертеже текстовый блок, в котором написано число 5 и некой переменной в программе присваивается значение 5). Помогите, пожалуйста. Заранее спасибо.
Просмотров: 9699

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Команда для экспорта ряда числовых значений из чертежа в Excel	AllA	AutoCAD	1	20.09.2010 10:22
Перенос данных из таблицы Автокада в Excel - дубль2	Таня.	AutoCAD	1	02.03.2009 16:08
Создание базы данных атрибутов текста чертежа в VBA	-still alive-	Программирование	4	26.08.2008 15:10
Параметрическое черчение в AutolLisp с использованием базы данных чертежа	Danger_pgs	LISP	31	02.04.2008 08:38