[Sleekka]

Здравствуйте, уважаемые коллеги.
Вопрос наверное ламерский, но я не так много работаю с объектным vlisp.
Суть в следующем
я юзаю библиотеку для работы с xml, которая опубликована на болоте

Код:

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

 ;;;************************************************************************
;;; api-xml.lsp
;;; Prepared by: J. Szewczak
;;; Date: 4 January 2004
;;; Purpose: To provide an API for interfacing with XML files.
;;; Copyright (c) 2004 - AMSEC LLC - All rights reserved
;;;************************************************************************
;;; Version 2004.01.04
;;;************************************************************************

;;;***********************************************************************
;;; MODULE: api-error
;;; DESCRIPTION: wraps a function to trap Active-X errors - if error is found
;;; DESCRIPTION: function returns nil.
;;; ARGS: function to check, list of arguments, boolean (return error message?) T or nil
;;; EXAMPLE: (api-error '/ (list 50 0) T) displays "VLISP Error: divide by zero" & returns 'nil'
;;;***********************************************************************

(defun api-error (func lst bool / trap)
  (cond
    ( (vl-catch-all-error-p
        (setq trap (vl-catch-all-apply func lst))
      )
      (if bool (princ (strcat "\nVLISP XML Error: " (vl-catch-all-error-message trap))))
      (setq trap nil)
    )
  )
  trap
)


;;;************************************************************************
;;; MODULE: XML-Get-Document
;;; DESCRIPTION: queries an XML file for the DOM Active-X object
;;; ARGS: XML file (string); a variable to store the DOM object
;;; EXAMPLE:(XML-Get-Document projfile 'XMLDoc) returns vla-object
;;;************************************************************************

(defun XML-Get-Document (file XMLDoc)
  (if (findfile file)
    (progn
      (set XMLDoc (vlax-create-object "MSXML2.DOMDocument.3.0")) ;;create XML-DOM pipeline
      (vlax-put-property (eval XMLDoc) "async" :vlax-false)
      (cond
        ( (api-error 'vlax-invoke-method (list (eval XMLDoc) "Load" file) T) ;; Load Project File into XML-DOM pipeline
          (eval XMLDoc)
        )
      )
    )
    (alert "\nXML Document could not be found.")
  )
)

;;;************************************************************************
;;; MODULE: XML-Get-XMLObject
;;; DESCRIPTION: this gets the top-level parent node object in a given XML Document
;;; ARGS: filename (string)
;;; EXAMPLE: (XML-Get-XMLObject filename) returns VLA-OBJECT
;;;************************************************************************

(defun XML-Get-XMLObject (file / docObj xmlTop xmlVer object)
  (if (findfile file)
    (progn
      (setq docObj (XML-Get-Document file 'docObj)
            xmlTop (vlax-get-property docObj "childNodes") ;; Get the Top Level of the XML
            xmlVer (vlax-invoke-method xmlTop "nextNode")  ;; Gets the XML version element
            object (vlax-invoke-method xmlTop "nextNode")  ;; Gets the Parent element
      )
    )
  )
  object
)

;;;************************************************************************
;;; MODULE: XML-Get-ElementKey
;;; DESCRIPTION: returns the requested tags text.
;;; ARGS: Parent - the parent collection object, tag name - must be unique tag name
;;; EXAMPLE: (XML-Get-ElementKey laydef "Name") returns "ANNOTATION"
;;;************************************************************************

(defun XML-Get-ElementKey (parent tag / el desc)
  (if (vlax-method-applicable-p parent 'getElementsByTagName)
    (progn
      (setq el (vlax-invoke-method parent 'getElementsByTagName tag))
      (if (> (vlax-get-property el 'Length) 0)
        (setq desc (vlax-get-property (vlax-invoke-method el 'nextNode) 'text))
      )
      (vlax-invoke-method el 'reset)
    )
    (princ "\nXML Object could not be searched.")
  )
  (if desc desc nil)
)

;;;************************************************************************
;;; MODULE: XML-Get-ElementKey-Object
;;; DESCRIPTION: returns the requested tags object.
;;; ARGS: Parent - the parent collection object, tag name - must be unique tag name
;;; EXAMPLE: (XML-Get-ElementKey-Object laydef "Name") returns VLA-OBJECT
;;;************************************************************************

(defun XML-Get-ElementKey-Object (parent tag / el desc)
  (if (vlax-method-applicable-p parent 'getElementsByTagName)
    (progn
      (setq el (vlax-invoke-method parent 'getElementsByTagName tag))
      (if (> (vlax-get-property el 'Length) 0)
        (setq desc (vlax-invoke-method el 'nextNode))
      )
      (vlax-invoke-method el 'reset)
    )
    (princ "\nXML Object could not be searched.")
  )
  (if desc desc nil)
)

;;;************************************************************************
;;; MODULE: XML-Get-Parent
;;; DESCRIPTION: Gets a top level object from the XML object with the given name
;;; ARGS: a valid XML object, the name of the parent level
;;; EXAMPLE: (XML-Get-Parent oXML "Leaders") returns VLA-OBJECT
;;;************************************************************************

(defun XML-Get-Parent (oXML name)
  (vlax-invoke-method
    (vlax-invoke-method oXML 'GetElementsByTagName name)
   'peekNode
  )
)

;;;************************************************************************
;;; MODULE: XML-Get-Children
;;; DESCRIPTION: gets the child object from a parent level
;;; ARGS: XML object, Parent name
;;; EXAMPLE: none
;;;************************************************************************

(defun XML-Get-Children (oXML parentName / return)
  (cond
    ( (/= parentName nil)
      (if (vlax-invoke-method (XML-Get-Parent oXML parentName) 'hasChildNodes)
        (setq return (vlax-get-property (XML-Get-Parent oXML parentName) 'childNodes))
      )
    )
    ( T (if (vlax-invoke-method oXML 'hasChildNodes) (setq return (vlax-get-property oXML 'childNodes))))
  )
  return
)

;;;************************************************************************
;;; MODULE: XML-Get-ChildList
;;; DESCRIPTION: returns a list of all child objects under a parent XML Object
;;; ARGS: XML object
;;; EXAMPLE: (XML-Get-ChildList objXML) returns a list of VLA-Objects
;;;************************************************************************

(defun XML-Get-ChildList (oXML / collection child lst)
  (cond
    ( (vlax-invoke-method oXML 'hasChildNodes)
      (setq collection (XML-Get-Children oXML nil))
      (while (setq child (vlax-invoke-method collection 'nextNode))
        (setq lst (if lst (cons child lst) (list child)))
      )
      (reverse lst)
    )
    (princ "\nObject has no children")
  )
)

;;;************************************************************************
;;; MODULE: XML-Get-Child
;;; DESCRIPTION: gets a specific child name under the parent level with given name
;;; ARGS: XML object, parent level, child name
;;; EXAMPLE: (setq oPointers (XML-Get-Child oXML "Leaders" "Pointers")) returns VLA-Object
;;; EXAMPLE: (XML-Get-Child oPointers nil "ArrowSize") used you only want to go one deep...
;;;************************************************************************

(defun XML-Get-Child (oXML parentName childName / child target)
  (cond
    ( (/= parentName nil) (setq child (XML-get-Children oXML parentName)))
    ( T (setq child (vlax-get-property oXML 'childNodes)))
  )
  (setq target (api-error 'vlax-invoke-method (list child 'nextNode) T))
  (while
    (and
      target
      (/= (vlax-get-property target 'tagName) childName)
    )
    (setq target (api-error 'vlax-invoke-method (list child 'nextNode) T))
  )
  target
)

;;;************************************************************************
;;; MODULE: XML-Get-Child-ByAttribute
;;; DESCRIPTION: gets a specific child name under the parent level with given attribute and attribute value
;;; ARGS: XML object, parent level, attribute to search by, attribute value to match
;;; EXAMPLE: (XML-Get-Child-ByAttribute oLayers "LayerDefinitions" "Name" "ANNOTATION") returns VLA-OBJECT
;;; EXAMPLE: (XML-Get-Child-ByAttribute oLayerDefs nil "Name" "ANNOTATION") used when you only want to go one deep...
;;;************************************************************************

(defun XML-Get-Child-ByAttribute (oXML parentName attrib attribValue / parent rtn)
  (if parentName
    (setq parent (XML-Get-Child oXML nil parentName))
    (setq parent oXML)
  )
  (foreach itm (XML-Get-ChildList parent)
    (if (= (XML-Get-Attribute itm attrib "") attribValue)
      (setq rtn itm)
    )
  )
  rtn
)

;;;************************************************************************
;;; MODULE: XML-Get-Child-Value
;;; DESCRIPTION: Retrieves the value from the 'Text property of a child element
;;; ARGS: XML object, parent Name, Child Name
;;; EXAMPLE: (XML-Get-Child-Value oXML "TaskInfo" "FSCM") returns "4T323"
;;;************************************************************************

(defun XML-Get-Child-Value (oXML parentName childName)
  (if (XML-Get-Child oXML parentName childName)
    (vlax-get-property (XML-Get-Child oXML parentName childName) 'text)
    nil
  )
)

;;;************************************************************************
;;; MODULE: XML-Put-Child
;;; DESCRIPTION: updates the text in a given child node
;;; ARGS: XML object, parent node name, child node to change, value to change to
;;; EXAMPLE: (XML-Put-Child oXML "DrawingSetup" "DrawingMode" "MicroScale")
;;;************************************************************************

(defun XML-Put-Child (oXML parentName childName valu / child return)
  (if
    (and
      valu
      (setq valu (vl-princ-to-string valu))
      (setq child (XML-Get-Child oXML parentName childName))
    )
    (api-error 'vlax-put-property (list child 'text valu) T)
  )
)

;;;************************************************************************
;;; MODULE: XML-Remove-Child
;;; DESCRIPTION: removes the specified child object node
;;; ARGS: XML node object
;;; EXAMPLE: (XML-Remove-Child oXML)
;;;************************************************************************

(defun XML-Remove-Child (rmvChild / parent)
  (setq parent (vlax-get-property rmvChild 'parentNode))
  (api-error 'vlax-invoke-method (list parent 'removeChild rmvChild) T)
)

;;;************************************************************************
;;; MODULE: XML-Add-Child
;;; DESCRIPTION: adds a Child element to the given parent object
;;; ARGS: Parent Level VLA-Object, name of new child
;;; EXAMPLE: (XML-Add-Child oXML "LayerKey") returns the newly created child node object
;;;************************************************************************

(defun XML-Add-Child (parent name / xmlDoc newElement return)
  (setq xmlDoc (vlax-get-property parent 'ownerDocument))
  (if (not parent) (setq parent xmlDoc))
  (if (setq newElement (api-error 'vlax-invoke-method (list xmlDoc 'createElement name) T))
    (setq return (api-error 'vlax-invoke-method (list parent 'appendChild newElement) T))
  )
  return
)

;;;************************************************************************
;;; MODULE: XML-Get-Attribute
;;; DESCRIPTION: returns an XML object's named attribute value
;;; ARGS: XML object, attribute name (string), a default value to return if there is no value found in the XML object
;;; EXAMPLE: (XML-Get-Attribute oXML "Name" "Default") might return "ANNOTATION"
;;;************************************************************************

(defun XML-Get-Attribute (oXML name default / att return)
  (if (setq att (api-error 'vlax-invoke-method (list oXML 'getAttributeNode name) T))
    (if att
      ;; due to the fact that the Text property strips trailing and leading white characters
      ;; when using the 'get' method.  the Value property has been used instead.
      (vlax-variant-value (vlax-get-Property att "Value"))
      default
    )
  )
)

;;;************************************************************************
;;; MODULE: XML-Get-Attribute-List
;;; DESCRIPTION: returns a list of strings corresponding to the names of the XML object's attributes
;;; ARGS: XML object
;;; EXAMPLE: (XML-Get-Attribute-List oXML) might return ("Name" "Color" "LineType" "LineWeight" "Plottable" "Comment")
;;;************************************************************************

(defun XML-Get-Attribute-List (oXML / lst attCollection count)
  (if (setq attCollection (vlax-get-property oXML 'attributes))
    (progn
      (setq count 0)
      (while (< count (vlax-get-property attCollection 'length))
        (setq lst (append lst (list (vlax-get-property (vlax-get-property attCollection 'item count) 'Name)))
              count (1+ count)
        )
      )
    )
  )
  lst
)

;;;************************************************************************
;;; MODULE: XML-Put-Attribute
;;; DESCRIPTION: function to put an XML attribute value -- will add the attribute if not already there
;;; ARGS: XML object, attribute name (string), a value to change the attribute to
;;; EXAMPLE: (XML-Put-Attribute oXML "Name" "Default") might return vla-object
;;;************************************************************************

(defun XML-Put-Attribute (oXML name valu / att return)
  (cond
    ( valu (setq valu (vl-princ-to-string valu)))
    ( (not valu) (setq valu ""))
  )
  (if (not (XML-Get-Attribute oXML name nil))
    (XML-Add-Attribute oXML name "")
  )
  (api-error 'vlax-invoke-method (list oXML 'setAttribute name valu) T)
)

;;;************************************************************************
;;; MODULE: XML-Add-Attribute
;;; DESCRIPTION: adds an attribute to the Parent Object with given name, and the optional value
;;; ARGS: Parent Level VLA-Object, name of new attribute, value (optional)
;;; EXAMPLE: (XML-Add-Attribute oXML "Name" "Default") returns the newly created attribute XML object.
;;;************************************************************************

(defun XML-Add-Attribute (parent name valu / xmlDoc newAttribute newAtt)
  (setq xmlDoc (vlax-get-property parent 'ownerDocument))
  (if (setq newAttribute (api-error 'vlax-invoke-method (list xmlDoc 'createAttribute name) T))
    (progn
      (setq attNodeMap (vlax-get-property parent 'attributes)
            newAtt (api-error 'vlax-invoke-method (list attNodeMap 'setNamedItem newAttribute) T)
      )
      (if valu (vlax-put-property newAtt 'Text valu))
    )
  )
  newAtt
)

;;;************************************************************************
;;; MODULE: XML-Get-Value
;;; DESCRIPTION: Retrieves the value from the 'Text property of the supplied XML Element object
;;; ARGS: XML object
;;; EXAMPLE: (XML-Get-Value oXML) returns "4T323"
;;;************************************************************************

(defun XML-Get-Value (oXML)
  (api-error 'vlax-get-property (list oXML 'text) T)
)

;;;************************************************************************
;;; MODULE: XML-Put-Value
;;; DESCRIPTION: Puts a text value into the 'Text property of the supplied XML Element object
;;; ARGS: XML object, text string
;;; EXAMPLE: (XML-Put-Value oXML "4T323") returns T if successful nil if not.
;;;************************************************************************

(defun XML-Put-Value (oXML str)
  (api-error 'vlax-put-property (list oXML 'text str) T)
  (if (= (XML-Get-Value oXML) str)
    T
    nil
  )
)

;;;************************************************************************
;;; MODULE: XML-SaveAs
;;; DESCRIPTION: Writes the parsed XML object out to the given file
;;; ARGS: XML document object or XML element object, fully qualified filename to save to
;;; EXAMPLE: (XML-SaveAs oXML "C:\\projects\\npy structure.swp")
;;;************************************************************************

(defun XML-SaveAs (oXML file)
  (cond
    ( (= (vlax-get-property oXML 'nodeTypeString) "element")
      (api-error 'vlax-invoke-method (list (vlax-get-property oXML 'ownerDocument) 'save file) T)
    )
    ( T (api-error 'vlax-invoke-method (list oXML 'save file) T))
  )
)

;;;************************************************************************
;;; MODULE: XML-Save
;;; DESCRIPTION: Writes the parsed XML object out to its parent file
;;; ARGS: XML document object or XML element object
;;; EXAMPLE: (XML-Save oXML)
;;;************************************************************************

(defun XML-Save (oXML / doc file)
  (cond
    ( (= (vlax-get-property oXML 'nodeTypeString) "element")
      (setq doc (vlax-get-property oXML 'ownerDocument))
    )
    ( T (setq doc oXML))
  )
  (setq file (vl-string-subst "\\" "/" (vl-string-left-trim "file:///" (vlax-get-property doc 'url))))
  (api-error 'vlax-invoke-method (list doc 'save file) T)
)

;;;************************************************************************
(princ)

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

я делал так, но свойства не присваиваются

Код:

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

 (setq sl_temp_ ent)
(XML-Remove-Child ent)

(setq oNewPiket (XML-Add-Child oPikets "Piket"))
(setq oNewPiket sl_temp_)

[Кулик Алексей aka kpblc]

А зачем менять порядок следования объектов? Зачастую это не играет никакой роли, мне кажется...
Хотя, если б у меня была подобная задача, то я полностью переписывал бы весь "родительский" узел. Потому что добавление элемента, как мне кажется, выполняется в конец его уровня.

[Sleekka]

Хотя, если б у меня была подобная задача, то я полностью переписывал бы весь "родительский" узел.

Видимо так и сделаю, просто думал что это можно решить проще в одну строку. Привык с обычными переменными работать.