Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Парсинг файла ХМL
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Подскажите пожалуйста!При открытии файла dwg, мне нужно открыть файл ХМL и считать из него данные для заполнения штама, готовый штамп я вставляю как блок на лист. в этом блоке созданы поля. причем для пользователя это должно быть прозрачно. Чем считывать файл и как данные впихнуть в блок. Спасибо
Для обработки открытия файла dwg - подпишись на событие AcadApplication.beginOpen , вроде оно.
Чтобы открыть файл XML (считать), воспользуйся готовыми средствами. Например "Microsoft XML v.#", который нужно подключить в Tools->References.
Вот, небольшой пример:
Public Sub ReadXML ()
Dim doc As New DOMDocument
doc.Load ("c:\book.xml")
Dim root As IXMLDOMElement
' Получение корневого элемента
Set root = doc.documentElement
Dim node As IXMLDOMNode
Dim node As IXMLDOMNodeList
' Получение коллекции узлов корневого элемента
set nodes = root.childNodes
For Each node In nodes
' Проверка типа узла
Select Case node.nodeType
Case NODE_ELEMENT
MsgBox(node.nodeName + " - " + node.text)
End Select
Next
End Sub
book.xml может быть таким
<books> <book>XML</book> <book>C++</book> </books>
Справку по Microsoft XML ищи в msdn.
подключила и уже написала
Dim nobjXMLDOM As New MSXML2.DOMDocument30
Dim nobjNode As MSXML2.IXMLDOMNode
Dim nobjNodes As IXMLDOMNodeList
Dim nobjBookNode As IXMLDOMNode
objDoc.Load "C:\2XMLPSD"
objXMLDOM.Load "C:\2XMLPSD.xml"
Dim i As Integer
Set objNodes = objXMLDOM.SelectNodes("DatePSD")
For Each objBookNode In objNodes
'If objBookNode.SelectNodes("Lists").Length <> 0 Then
Set Lists = objBookNode.SelectNodes("Lists")
For Each List In Lists
Set temp2 = List.SelectNodes("Count")
For Each ListN In temp2
Set temp3 = ListN.SelectNodes("Count") \\\\слетает здесь
Next
Next
Next objBookNode файл такой
<?xml version="1.0" encoding="utf-8" ?> - <DatePSD> - <Lists Count="1"> - <List Name="Лист1" Format="А2"> - <Stamp> - <Development> - <RowStampOne> <ColumnDesc>Разраб.</ColumnDesc> <ColumnInitials>Гирда</ColumnInitials> <ColumnSign>http://tmn-ntc-pir/images/sign1.jpg</ColumnSign> <ColumnDate>05.10</ColumnDate> </RowStampOne> - <RowStampTwo> <ColumnDesc>Пров.</ColumnDesc> <ColumnInitials>Бурякова</ColumnInitials> <ColumnSign>http://tmn-ntc-pir/images/sign2.jpg</ColumnSign> <ColumnDate>05.10</ColumnDate> </RowStampTwo> - <RowStampThree> <ColumnDesc>Гл.спец</ColumnDesc> <ColumnInitials>Генералова</ColumnInitials> <ColumnSign>http://tmn-ntc-pir/images/sign3.jpg</ColumnSign> <ColumnDate>05.10</ColumnDate> </RowStampThree> - <RowStampFour> <ColumnDesc>Н.контроль</ColumnDesc> <ColumnInitials>Генералова</ColumnInitials> <ColumnSign>http://tmn-ntc-pir/images/sign3.jpg</ColumnSign> <ColumnDate>05.10</ColumnDate> </RowStampFour> - <RowStampFive> <ColumnDesc /> <ColumnInitials /> <ColumnSign /> <ColumnDate /> </RowStampFive> - <RowStampSix> <ColumnDesc /> <ColumnInitials /> <ColumnSign /> <ColumnDate /> </RowStampSix> </Development> </Stamp> - <PDF> <Name>file1.pdf</Name> <Li nk>http://tmn-ntc-pir/file1.pdf</Link> </PDF> </List> </Lists> </DatePSD>
запуталась в вложенностях!!
Подредактируй последний пост. тэги проставь. Сложно читать.
Так лучше, но не совсем. Отступы куда дела.
<?xml version="1.0" encoding="UTF-8"?>
<DatePSD>
<Lists Count="1">
<List Name="Лист1" Format="А2">
<Stamp>
<Development>
<RowStampOne>
<ColumnDesc>Разраб.</ColumnDesc>
<ColumnInitials>Гирда</ColumnInitials>
<ColumnSign>http://tmn-ntc-pir/images/sign1.jpg</ColumnSign>
<ColumnDate>05.10</ColumnDate>
</RowStampOne>
<RowStampTwo>
<ColumnDesc>Пров.</ColumnDesc>
<ColumnInitials>Бурякова</ColumnInitials>
<ColumnSign>http://tmn-ntc-pir/images/sign2.jpg</ColumnSign>
<ColumnDate>05.10</ColumnDate>
</RowStampTwo>
<RowStampThree>
<ColumnDesc>Гл.спец</ColumnDesc>
<ColumnInitials>Генералова</ColumnInitials>
<ColumnSign>http://tmn-ntc-pir/images/sign3.jpg</ColumnSign>
<ColumnDate>05.10</ColumnDate>
</RowStampThree>
<RowStampFour>
<ColumnDesc>Н.контроль</ColumnDesc>
<ColumnInitials>Генералова</ColumnInitials>
<ColumnSign>http://tmn-ntc-pir/images/sign3.jpg</ColumnSign>
<ColumnDate>05.10</ColumnDate>
</RowStampFour>
<RowStampFive>
<ColumnDesc />
<ColumnInitials />
<ColumnSign />
<ColumnDate />
</RowStampFive>
<RowStampSix>
<ColumnDesc />
<ColumnInitials />
<ColumnSign />
<ColumnDate />
</RowStampSix>
</Development>
</Stamp>
<PDF>
<Name>file1.pdf</Name>
<Li nk>http://tmn-ntc-pir/file1.pdf</Link>
</PDF>
</List>
</Lists>
</DatePSD>Последний раз показываю.)
По существу, вроде все элементарно.
Запуталась наверо, потому что код, как спагетти. Разбей на функции или классы.
Может позже пример напишу.
Спасибо! напишите пожалуйста, просто работа горит а MSXML я только второй день в глаза вижу
Вот, что я накалякал.
Это вставь в модуль
Option Explicit
' Считывание xml и получение коллекции описания листов и штампов
Public Sub ReadStampFromXML()
Dim colList As New Collection
Dim doc As New DOMDocument
' Чтение файла
doc.Load "d:\book.xml"
Dim root As IXMLDOMElement
' Получение корневого элемента
Set root = doc.documentElement
Dim lists As IXMLDOMElement
' Получение элемента Lists
Set lists = GetElement(root, "Lists")
Dim node As IXMLDOMNode
Dim elem As IXMLDOMElement
Dim elemDevelop As IXMLDOMElement
' Для всех елементов в элементе Lists
For Each node In lists.childNodes
If node.nodeType = NODE_ELEMENT _
And node.nodeName = "List" Then
Set elem = node
' Создаем новое описание листа и заполняем его
Dim list As New clList
list.Name = elem.getAttribute("Name")
list.Format = elem.getAttribute("Format")
Set elem = GetElement(elem, "Stamp")
Set elemDevelop = GetElement(elem, "Development")
Set elem = GetElement(elemDevelop, "RowStampOne")
Set list.row1 = GetRowStamp(elem)
Set elem = GetElement(elemDevelop, "RowStampTwo")
Set list.row2 = GetRowStamp(elem)
Set elem = GetElement(elemDevelop, "RowStampThree")
Set list.row3 = GetRowStamp(elem)
Set elem = GetElement(elemDevelop, "RowStampFour")
Set list.row4 = GetRowStamp(elem)
Set elem = GetElement(elemDevelop, "RowStampFive")
Set list.row5 = GetRowStamp(elem)
Set elem = GetElement(elemDevelop, "RowStampSix")
Set list.row6 = GetRowStamp(elem)
' Добавление листа в коллекцию
colList.Add list
End If
Next
End Sub
' Получение элемента по имени из родительского элемента
Private Function GetElement(parent As IXMLDOMElement, Name As String) As IXMLDOMElement
If parent Is Nothing Then
Exit Function
End If
Dim node As IXMLDOMNode
For Each node In parent.childNodes
If node.nodeType = NODE_ELEMENT _
And node.nodeName = Name Then
Set GetElement = node
Exit Function
End If
Next
End Function
' Получение строки из элемента строки
Private Function GetRowStamp(rowStamp As IXMLDOMElement) As clRow
If rowStamp Is Nothing Then
Exit Function
End If
Set GetRowStamp = New clRow
Dim elem As IXMLDOMElement
Set elem = GetElement(rowStamp, "ColumnDesc")
GetRowStamp.Desc = elem.text
Set elem = GetElement(rowStamp, "ColumnInitials")
GetRowStamp.Initials = elem.text
Set elem = GetElement(rowStamp, "ColumnSign")
GetRowStamp.Sign = elem.text
Set elem = GetElement(rowStamp, "ColumnDate")
GetRowStamp.Data = elem.text
End FunctionИ создай классы:
clList
Public Name As String Public Format As String Public row1 As clRow Public row2 As clRow Public row3 As clRow Public row4 As clRow Public row5 As clRow Public row6 As clRow
clRow
Public Desc As String Public Initials As String Public Sign As String Public Data As String
Ессно, поменяй путь к xml.
В итоге должна получить коллекцию colList с объектами класса clList.
Спасибо огромное!! :{}
извиняюсь за тупые вопросы
на Public row1 As clRow выдает User-defined type not defined
Option Explicit Public Name As String Public Format As String Public row1 As clRow Public row2 As clRow Public row3 As clRow Public row4 As clRow Public row5 As clRow Public row6 As clRow Public Desc As String Public Initials As String Public Sign As String Public Data As String
Внимательнее глянь мой посл. пост. Два класса нужно создать. Ты похоже в один все пихнула.
да нет похоже я просто не умею классы создавать! бестолковая голова :cry: раньше в дельфи писала, теперь переучиваюсь на ходу
Меню Insert->Class Module
В свойствах созданного класса, укажи Name - "clList".
спасибо большое! благодарность от ушей и до хвоста! классы объявила поняла что и где
сейчас гоняю.
Dim list As New clList
list.Name = elem.getAttribute("Name") в этом месте выдает method or data member not found
класс объявлен :(
1. Проверь класс clList. Убедись, что его содержание такое:
Public Name As String Public Format As String Public row1 As clRow Public row2 As clRow Public row3 As clRow Public row4 As clRow Public row5 As clRow Public row6 As clRow
2. Поставь точку остановки в этой строчке. Посмотри в окно Locals, elem - точно List. Если нет, значит ошибка в xml. Попробуй его открыть в любом браузере.
xml открываю в Explorer нормально
при компиляции сразу выдает method or data member not found причем именно на list.Name
код я запихнула под кнопку на форме, но я не думаю, что из за этого проблемы
Sub CommandButton7_Click() ReadStampFromXML
А 1 пункт проверила.
Давай почту, пришлю весь проект.
конечно проверила <Elis1973@yandex.ru>
Отправил.
Для прикола, пришли свой, гляну что не так.
Получил, посмотрел, нашел.
В UserForm1, в коде, объявлены поля:
Public Name As String Public Format As String Public row1 As clRow Public row2 As clRow Public row3 As clRow Public row4 As clRow Public row5 As clRow Public row6 As clRow 'clRow Public Desc As String Public Initials As String Public Sign As String Public Data As String
Они перекрывают переменные класов. Их нужно удалить.
разобралась! спасибо! в продолжение банкета вставляю блок штампа
Dim blockObj As AcadBlock
Dim blockObjsh As AcadBlock
Dim insertionPnt(0 To 2) As Double
Dim insertionPntshtamp(0 To 2) As Double
Dim stringpath As String
Dim stringpathnew As String
Dim strpathsht As String
Dim strto As String
''''
Dim objLayout As AcadLayout
Dim objEnt As AcadObject
Dim objNewLayout As AcadLayout
Dim colLayOuts As AcadLayouts
Dim objEntArray() As Object
Dim intCnt As Integer
Dim blnExists As Boolean
Set colLayOuts = ThisDrawing.Layouts
stringpathnew = "C:\bloks\" + stringpath + ".dwg"
strpathsht = "C:\bloks\blockshtamp.dwg"
Dim blockRefObj As AcadBlockReference
Dim blockObjshtamp As AcadBlockReference
'insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
insertionPnt(0) = -5
insertionPnt(1) = -5
insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, stringpath)
Set blockRefObj = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, stringpathnew, 1#, 1#, 1#, 0)нужно запихнуть в блок текст из данных полученных из XML
Предлагаю продолжение банкета в новой теме. Каша получается.
Создавай новую тему из последнего поста.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Парсинг файла ХМL
Форум работает на PunBB, при поддержке Informer Technologies, Inc
