LISP - export coordinates to XML

[Anonymous]

Hi !

hi !

my list command shows me :

LWPOLYLINE Layer: "0"
Space: Model space
Handle = 2a4
Closed
Constant width 0.0000
area 4322.9452
perimeter 443.9655

at point X= 27.8339 Y= 47.2804 Z= 0.0000
at point X= 218.0915 Y= 108.9413 Z= 0.0000
at point X= 223.3759 Y= 91.6231 Z= 0.0000
at point X= 34.6587 Y= 23.1296 Z= 0.0000

i want to export just the coordinates , but in this format :

<Points>
<POINTID>1</POINTID>
<IMMOVABLEID>1</IMMOVABLEID>
<NO>1</NO>
<X>27.8339</X>
<Y>47.2804</Y>
</Points>
<Points>
<POINTID>2</POINTID>
<IMMOVABLEID>1</IMMOVABLEID>
<NO>2</NO>
<X>218.0915</X>
<Y>108.9413</Y>
</Points>
<Points>
<POINTID>3</POINTID>
<IMMOVABLEID>1</IMMOVABLEID>
<NO>3</NO>
<X>223.3759</X>
<Y>491.6231</Y>
</Points>
<Points>
<POINTID>4</POINTID>
<IMMOVABLEID>1</IMMOVABLEID>
<NO>4</NO>
<X>34.6587</X>
<Y>23.1296</Y>
</Points>

if it has 3 points , to export 3 points ... if it has 50 points , to export 50 points , starting with point 1 on each export.

can it be done to ask me where to export it ?

i attached a file with the coordinates and a file without the coordinates ...

Thatks !

[dgorsman]

Should be entirely possible.  You might want to make a couple of changes though, if the XML content will allow it.  Consider changing the <Points> element name to a singular Point for clarity.  And start the vertex numbering at 0 rather than 1, which will help with later processing. 

[ВeekeeCZ · Accepted solution]

This should work. Since I have no experience with XML structure consider @dgorsman's notes.

(vl-load-com)

(defun c:PlineToXml (/ *error* :ReadFile :XmlPoint xml f vrs i)


    (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
  
  (defun :ReadFile (name / lst)
    (if (setq f (open name "r"))
      (while (setq l (read-line f))
        (setq lst (cons l lst))))
    (if f (close f))
    (reverse lst))
  
  (defun :XmlPoint (p i /)
    (list "  <Points>"
          (strcat "    <POINTID>" i "</POINTID>")
          (strcat "    <IMMOVABLEID>1</IMMOVABLEID>")
          (strcat "    <NO>" i "</NO>")
          (strcat "    <X>" (rtos (car  p) 2 3 ) "</X>")
          (strcat "    <Y>" (rtos (cadr p) 2 3 ) "</Y>")
          "  </Points>"))
  
  ; ---------------------------------------------------------------
  
  (or *p2x-path*
      (setq *p2x-path* (getvar 'DWGPREFIX)))
  
  (if (and (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
           (setq name (getfiled "Select XML file: " *p2x-path* "cgxml" 4))
           (setq *p2x-path* (strcat (vl-filename-directory name) "\\"))
           (setq xml (:ReadFile name))
           (or (not (member "  <Points>" xml))
               (alert "Error: File already includes points."))
           (setq vrs (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss 0)))))
           (setq f (open name "w"))
           (setq i 0) ; initial number is i+1
           )
    (progn
      (while (and (car xml)
                  (/= (car xml) "  <Registration>")
                  )
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      
      (foreach vrt vrs
        (foreach l (:XmlPoint vrt (itoa (setq i (1+ i))))
          (write-line l f)))
      
      (while (car xml)
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      (close f)
      ))
  (princ)
  )

Also HERE are some guidelines how to run LISP in case you don't know already.

[dgorsman]

Thanks @ВeekeeCZ .

While it's possible to manually create XML using text strings I *highly* recommend using VLISP to access the MSXML2.DOMDOCUMENT.6.0 DOM.  It's not much more work, and guarantees properly formed XML.  It also makes accessing the elements much easier. 

[Anonymous]

Thank you !!!

You are the best !

🙂

[Anonymous]

@BeekeeCZ , need something more ...

It works perfect if i don`t have points in my XML file.

if i have points in my xml , it gives me an error ... and in some files it puts the text that i want after the </CGXML> line (and it does not work). i uploaded a file that suffers that ...

can you modify it a little ?

i mean :

1) if the XML file has points , remove all points and insert the points after that

2) insert the points on line 2 ( after <CGXML> line)

first one is the harder job ... i think to myself ...

What can i do for you ?

you really helped me untill now !

if you do this modifications i really want to help you somehow !

[ВeekeeCZ · Accepted solution]

Not really sure if I understood you correctly, but try the modified code.

The key tag is <registration>. The points are always placed before it. It there is the <points> tag already, all lines from that to <registration> are removed.

If the above rules wouldn't be enough and it should get more complicated, then it might be the right time to move to a more appropriate and comprehensive solution mentioned by @dgorsman . 

BTW you should try to read the code and get understand the principle to be able to do at least minor adjustments by your own.

Greetings to Romania!

(vl-load-com)

(defun c:PlineToXml (/ *error* :ReadFile :XmlPoint xml f vrs i)


    (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
  
  (defun :ReadFile (name / lst)
    (if (setq f (open name "r"))
      (while (setq l (read-line f))
        (setq lst (cons l lst))))
    (if f (close f))
    (reverse lst))
  
  (defun :XmlPoint (p i /)
    (list "  <Points>"
          (strcat "    <POINTID>" i "</POINTID>")
          (strcat "    <IMMOVABLEID>1</IMMOVABLEID>")
          (strcat "    <NO>" i "</NO>")
          (strcat "    <X>" (rtos (car  p) 2 3 ) "</X>")
          (strcat "    <Y>" (rtos (cadr p) 2 3 ) "</Y>")
          "  </Points>"))
  
  ; ---------------------------------------------------------------
  
  (or *p2x-path*
      (setq *p2x-path* (getvar 'DWGPREFIX)))
  
  (if (and (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
           (setq name (getfiled "Select XML file: " *p2x-path* "cgxml" 4))
           (setq *p2x-path* (strcat (vl-filename-directory name) "\\"))
           (setq xml (:ReadFile name))
           (setq vrs (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss 0)))))
           (setq f (open name "w"))
           (setq i 0) ; initial number is i+1
           )
    (progn
      (while (and (car xml)
                  (not (wcmatch (strcase (car xml) T) "*<registration>*,*<points>*"))) 	; write back all until <registration> or <point*> tag reached
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      
      (foreach vrt vrs									; write all new points
        (foreach l (:XmlPoint vrt (itoa (setq i (1+ i))))
          (write-line l f)))

      (while (and (car xml)								; skip all current <points> if there are any (untill <registration> tag reached)
                  (not (wcmatch (strcase (car xml) T) "*<registration>*")))
        (setq xml (cdr xml)))
      
      (while (car xml)									; write all the rest.
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      (close f)
      ))
  (princ)
  )
 

[Anonymous]

i have another problem ...

there are some files that contains vital information between the last </POINTS and <REGISTRATION>

The problem is that it deletes that 😞

before it looks like this :

...

<Points>
<POINTID>30013</POINTID>
<IMMOVABLEID>10001</IMMOVABLEID>
<NO>30013</NO>
<X>689470.514805319</X>
<Y>476069.298022253</Y>
</Points>
<Address>
<ADDRESSID>10001</ADDRESSID>
<SIRSUP>75515</SIRSUP>
<SIRUTA></SIRUTA>
<INTRAVILAN>false</INTRAVILAN>
<DISTRICTTYPE></DISTRICTTYPE>
<DISTRICTNAME></DISTRICTNAME>
<STREETTYPE></STREETTYPE>
<STREETNAME></STREETNAME>
<POSTALNUMBER></POSTALNUMBER>
<BLOCK></BLOCK>
<ENTRY></ENTRY>
<FLOOR></FLOOR>
<APNO></APNO>
<ZIPCODE></ZIPCODE>
<DESCRIPTION></DESCRIPTION>
<SECTION></SECTION>
</Address>
<Parcel>
<PARCELID>10002</PARCELID>
<LANDID>10001</LANDID>
<NUMBER>1</NUMBER>
<MEASUREDAREA>240232.0</MEASUREDAREA>
<USECATEGORY>P</USECATEGORY>
<INTRAVILAN>false</INTRAVILAN>
<TITLENO></TITLENO>
<LANDPLOTNO>13/1</LANDPLOTNO>
<PARCELNO>83/4</PARCELNO>
<PAPERCADNO></PAPERCADNO>
<PAPERLBNO></PAPERLBNO>
<TOPONO></TOPONO>
<CADGENNO></CADGENNO>
</Parcel>
<RegistrationXEntity>
<REGISTRATIONXENTITYID>10001</REGISTRATIONXENTITYID>
<REGISTRATIONID>10001</REGISTRATIONID>
<LANDID>10001</LANDID>
</RegistrationXEntity>
<Registration>
<REGISTRATIONID>10001</REGISTRATIONID>
<REGISTRATIONTYPE>INTAB</REGISTRATIONTYPE>
<RIGHTTYPE>PROPRIETATE</RIGHTTYPE>
<DEEDID>10001</DEEDID>
<TITLE>LEGE</TITLE>
<QUOTATYPE>FRACTION_QUOTA</QUOTATYPE>
<INITIALQUOTA>1/1</INITIALQUOTA>
<ACTUALQUOTA>1/1</ACTUALQUOTA>
<VALUECURRENCY></VALUECURRENCY>
<VALUEAMOUNT></VALUEAMOUNT>
<COMMENTS></COMMENTS>
<LBPARTNO>2</LBPARTNO>
<POSITION>1</POSITION>
<APPNO>4858</APPNO>
<APPDATE>2018-03-29T00:00:00.000+03:00</APPDATE>
</Registration>
<Deed>
<DEEDID>10001</DEEDID>
<DEEDNUMBER>ordinul nr. 749</DEEDNUMBER>
<DEEDDATE>2011-06-29T00:00:00.000+03:00</DEEDDATE>
<DEEDTYPE>ACT_NORMATIV</DEEDTYPE>
<AUTHORITY>INSTITUTIA PREFECTULUI JUDETUL GALATI</AUTHORITY>
<FILEID>0</FILEID>
</Deed>

...

and after :

...

<Points>
<POINTID>1</POINTID>
<IMMOVABLEID>1</IMMOVABLEID>
<NO>30013</NO>
<X>689470.514805319</X>
<Y>476069.298022253</Y>
</Points>
<RegistrationXEntity>
<REGISTRATIONXENTITYID>10001</REGISTRATIONXENTITYID>
<REGISTRATIONID>10001</REGISTRATIONID>
<LANDID>10001</LANDID>
</RegistrationXEntity>
<Registration>
<REGISTRATIONID>10001</REGISTRATIONID>
<REGISTRATIONTYPE>INTAB</REGISTRATIONTYPE>
<RIGHTTYPE>PROPRIETATE</RIGHTTYPE>
<DEEDID>10001</DEEDID>
<TITLE>LEGE</TITLE>
<QUOTATYPE>FRACTION_QUOTA</QUOTATYPE>
<INITIALQUOTA>1/1</INITIALQUOTA>
<ACTUALQUOTA>1/1</ACTUALQUOTA>
<VALUECURRENCY></VALUECURRENCY>
<VALUEAMOUNT></VALUEAMOUNT>
<COMMENTS></COMMENTS>
<LBPARTNO>2</LBPARTNO>
<POSITION>1</POSITION>
<APPNO>4858</APPNO>
<APPDATE>2018-03-29T00:00:00.000+03:00</APPDATE>
</Registration>
<Deed>
<DEEDID>10001</DEEDID>
<DEEDNUMBER>ordinul nr. 749</DEEDNUMBER>
<DEEDDATE>2011-06-29T00:00:00.000+03:00</DEEDDATE>
<DEEDTYPE>ACT_NORMATIV</DEEDTYPE>
<AUTHORITY>INSTITUTIA PREFECTULUI JUDETUL GALATI</AUTHORITY>
<FILEID>0</FILEID>
</Deed>

...

i have to change that condition : 

(progn
(while (and (car xml)
(not (wcmatch (strcase (car xml) T) "*<registration>*,*<points>*"))) ; write back all until <registration> or <point*> tag reached
(write-line (car xml) f)
(setq xml (cdr xml)))

(foreach vrt vrs ; write all new points
(foreach l (:XmlPoint vrt (itoa (setq i (1+ i))))
(write-line l f)))

(while (and (car xml) ; skip all current <points> if there are any (untill <registration> tag reached)
(not (wcmatch (strcase (car xml) T) "*<registration>*")))
(setq xml (cdr xml)))

and instead of deleting all from point to registration , i just want to delete all the points.

Can you do that for me ?

Please ?

[bcddss]

(vl-load-com)

(defun c:PlineToXml (/ *error* :ReadFile :XmlPoint xml f vrs i)


    (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
  
  (defun :ReadFile (name / lst)
    (if (setq f (open name "r"))
      (while (setq l (read-line f))
        (setq lst (cons l lst))))
    (if f (close f))
    (reverse lst))
  
  (defun :XmlPoint (p i /)
    (list "  <Points>"
          (strcat "    <POINTID>" i "</POINTID>")
          (strcat "    <IMMOVABLEID>1</IMMOVABLEID>")
          (strcat "    <NO>" i "</NO>")
          (strcat "    <X>" (rtos (car  p) 2 8 ) "</X>")
          (strcat "    <Y>" (rtos (cadr p) 2 8 ) "</Y>")
          "  </Points>"))
  
  ; ---------------------------------------------------------------
  
  (or *p2x-path*
      (setq *p2x-path* (getvar 'DWGPREFIX)))
  
  (if (and (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
           (setq name (getfiled "Select XML file: " *p2x-path* "cgxml" 4))
           (setq *p2x-path* (strcat (vl-filename-directory name) "\\"))
           (setq xml (:ReadFile name))
           (setq vrs (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss 0)))))
           (setq f (open name "w"))
           (setq i 0) ; initial number is i+1
           )
    (progn
      (while (and (car xml)
                  (not (wcmatch (strcase (car xml) T) "*<points>*"))) 	; write back all until <registration> or <point*> tag reached
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      
      (foreach vrt vrs									; write all new points
        (foreach l (:XmlPoint vrt (itoa (setq i (1+ i))))
         (write-line l f)))

      (while (and (car xml)								; skip all current <points> if there are any (untill <address> tag reached)
            (not (wcmatch (strcase (car xml) T) "*<address>*")))
	
      (setq xml (cdr xml)))
      
      (while (car xml)									; write all the rest.
        (write-line (car xml) f)
        (setq xml (cdr xml)))
      (close f)
      ))
  (princ)
  )

 Try this! Modify only line with <address> 

[bcddss]

One more thing is to insert last point the point nr 1, to complete the CGXML. Please help!