[АртурМ]

Здравствуйте, коллеги.

Имеется макрос в excele, для замены определённого stext с определенной меткой в автокаде на забитое в excel ячейке значение (допустим есть поле с какой-либо фамилией в поле автор, при чём не важно с какой, важно то что у этого stext, есть метка), так вот стоит сейчас передо мной вопрос, как в автокаде элементу конкретному stext присвоить эту самую метку. Знаю, что как то через GetXData, но вот за какое свойство прицепится в каждом конкретном stext понятия не имею, для знающих людей прикладываю кусок кода, заранее огромное спасибо за помощь.

'Выбор об'ектов
Set sstext = objAcadDoc.SelectionSets.Add("SS1")
FilterType(0) = 1001: FilterData(0) = "XData_Set_App"

Dim xdataOut As Variant
Dim xtypeOut As Variant

sstext.Select acSelectionSetAll, , , FilterType, FilterData

'редактирование

'цикл по выборке
For Each i In sstext
i.GetXData "XData_Set_App", xtypeOut, xdataOut
'цикл по ячейкам
For Each objCell In Selection
strName = objCell.Value
varVal = objCell.Offset(0, 1).Value
strVal = varVal
If xdataOut(1) = strName Then i.TextString = strVal
Next

[Сергей Богатов]

почитай тут
http://docs.autodesk.com/ACAD_E/2012...70276f77ea.htm

PS
А какая цель? Опиши общую задачу. Может быть обойтись без Xdata...

[АртурМ]

Сергей, данную тему уже читал, неоднократно, но как реализовать её на практике приминительно к stext'y не совсем понимаю, а точнее совсем не понимаю возможно упускаю какую-то важную деталь в переводе. Если есть какие-то конкретные решения, или ссылки на литературу с конкретными примерами по stext'y с удовольствием бы ознакомился.

p/s

Цель такова... есть множество элементов stext в доке .dwg, в excele в определённую ячейку я вбиваю значение, ну опять таки пусть это будет фамилия автора, к этой ячейке, уже присвоена ссылка к примеру author.

For Each currCell In Range("A11", "A20")
If currCell.Value = "" Then Exit For
If currCell.Hyperlinks.Item(1).Address Like "?:\*" Then
strPath = currCell.Hyperlinks.Item(1).Address
Else
strPath = ActiveWorkbook.Path & "\" & currCell.Hyperlinks.Item(1).Address
End If

Я пытаюсь добиться следующего, чтобы вбивая значение в excele, запуская макрос, все значения заменялись в автокаде, на те, что я уже вбил в excel.
И это работает, мои предшественники, которые являются собственно говоря авторами макроса, это реализовали, но они это реализовали к ограниченному количеству stext элементов. Я же хочу пойти дальше, и автоматизировать замену того, что они не автоматизировали. Вот собственно говоря и пытаюсь додуматься, как же они присвоили ID к конкретному элементу stext

[Сергей Богатов]

ну а из примеров в ХЕЛПе?

Код:

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

Dim entHandle As String
    Dim entry As AcadEntity
    For Each entry In ThisDrawing.ModelSpace
        entHandle = entry.handle
        entry.Highlight (True)
        MsgBox "The handle of this object is " & entHandle, vbInformation, "Handle Example"
        entry.Highlight (False)
    Next

Хотя всё равно непонятно... Объясни с чего всё начинается?
Ты делаешь что? Сначала обращаешься к определённым ТЕКСТам и ставишь на них Xdata - метку, а потом создаёшь экселевский файл с этими метками(1 столбец), руками заполняешь 2 столбец и хочешь чтобы значения этих ТЕКСТов с метками заменялись в соответствии с 2 столбцом?
P.S.
А не про заполнение-ли основных надписей мы говорим?
P.P.S.
Кстати было бы разумно предоставить код твоих "предшественников". Там и будет видно откуда они берут привязку

[АртурМ]

Сообщение от Сергей Богатов Ты делаешь что? Сначала обращаешься к определённым ТЕКСТам и ставишь на них Xdata - метку, а потом создаёшь экселевский файл с этими метками(1 столбец), руками заполняешь 2 столбец и хочешь чтобы значения этих ТЕКСТов с метками заменялись в соответствии с 2 столбцом?

абсолютно верно

Сообщение от Сергей Богатов P.S. А не про заполнение-ли основных надписей мы говорим?

вот заполнение основных надписей они реализовали, я хочу реализовать замену всего, что мне может потребоваться.

Сообщение от Сергей Богатов P.P.S. Кстати было бы разумно предоставить код твоих "предшественников". Там и будет видно откуда они берут привязку

Sub qMakeAcadDocuments()
Dim objAcad As New AutoCAD.AcadApplication
Dim objAcadDoc As AutoCAD.AcadDocument
Dim strName As String
Dim strVal As String
Dim varVal As Variant
Dim objTbl As Range, currCell As Range
Dim objCell As Range
Dim strInput As String
Dim strPath As String
'Dim i As Integer

Dim sstext As AcadSelectionSet
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant
Dim DataType(0 To 1) As Integer
Dim Data(0 To 1) As Variant
Dim i As Variant


Set objTbl = ActiveCell.CurrentRegion

For Each currCell In Range("A2", "A10")
If currCell.Value = "" Then Exit For
If currCell.Hyperlinks.Item(1).Address Like "?:\*" Then
strPath = currCell.Hyperlinks.Item(1).Address
Else
strPath = ActiveWorkbook.Path & "\" & currCell.Hyperlinks.Item(1).Address
End If
'открытие автокадовского документа
With objAcad
.Visible = True
.WindowState = acMax
Set objAcadDoc = .Documents.Open(strPath)
End With

objTbl.Offset(0, 1).Resize(objTbl.Rows.Count, 1).Select

' удаление selection
On Error GoTo ErrorHandler1
objAcadDoc.SelectionSets.Item("SS1").Delete
ErrorHandler1:

'Выбор об'ектов
Set sstext = objAcadDoc.SelectionSets.Add("SS1")
FilterType(0) = 1001: FilterData(0) = "XData_Set_App"

Dim xdataOut As Variant
Dim xtypeOut As Variant

sstext.Select acSelectionSetAll, , , FilterType, FilterData

'редактирование

'цикл по выборке
For Each i In sstext
i.GetXData "XData_Set_App", xtypeOut, xdataOut
'цикл по ячейкам
For Each objCell In Selection
strName = objCell.Value
varVal = objCell.Offset(0, 1).Value
strVal = varVal
If xdataOut(1) = strName Then i.TextString = strVal
Next
Next

On Error GoTo ErrorHandler2
objAcadDoc.SelectionSets.Item("SS1").Delete
ErrorHandler2:

Set sstext = Nothing
objAcadDoc.Save
objAcadDoc.Close

Next

objAcad.Quit
Set objAcad = Nothing
End Sub

Это то, что в excel VBA

Сообщение от Сергей Богатов Сначала обращаешься к определённым ТЕКСТам и ставишь на них Xdata - метку

вот эту ступень я не понимаю как они реализовали. Проекта VBA в автокаде с этим кодом не имею, подозреваю, что в одном документе stextам присвоили метки и просто их скопировали в другой.

[Сергей Богатов]

Хм - а экселевский файл как выглядит? Вообще-то, похоже, что это какая-то неправильная штука. Логичнее использовать блоки с атрибутами. Нужно видеть код которым "они" задавали эти XData. Если вручную - то это бред...
PS
Всё-таки полностью опиши что ты хочешь от программы. Конкретные действия. Без привязки к тому что сделали "предшественники"

[АртурМ]

Сообщение от Сергей Богатов Хм - а экселевский файл как выглядит? Вообще похоже что это какая-то неправильная штука. Логичнее использовать блоки с атрибутами. Нужно видеть код которым "они" задавали эти XData. Если вручную - то это бред... PS Всё-таки полностью опиши что ты хочешь от программы. Конкретные действия. Без привязки к тому что сделали "предшественники"

один в один, как ты упомянул выше, 2 столбца, в одном метки, во втором вбиваю значения.

Хочу я следующее...
У меня есть 4 файла dwg, в каждом по 4 чертежа, в них есть множество текстовых полей, начиная со штампов (что они собственно реализовали), заканчивая различными значениями, которые от проекта к проекту меняются, перебивать в ручную не то, чтобы лень (хотя и это тоже), но такая перебивка ведёт за собой последствия, связанные с невнимательностью, хоть на одном чертеже из 16, но могу пропустить какое-либо значение перебить. Мне гораздо проще один раз, каждому из этих текстовых полей присвоить метки, и забивая их в excele осуществлять автозамену. Я готов позаморачиваться и сделать привязку в ручную, только объясните мне кто-нибудь как Один раз позаморачиваюсь, зато потом не буду в куче документов перебивать одинаковые значения

[Сергей Богатов]

так используй ПОМОЩЬ.

Код:

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

object.SetXData XDataType, XData
object.GetXData AppName, XDataType, XDataValue

примеры там более чем понятные

P.S.
Для оформления основных надписей (и не только) присмотрись к подшивкам.