Export Xdata to excel

[karunakaran1991]

I got the code form website, but i forget the site.

Brief info of the code : Gets a application name of Xdata attached in drawing and process the Xdata related the application name and export it to excel file.

The problem:  Export is limited to first three column, attached Image1 shows the Xdata attached with Auto cad Entity and Image2 shows the Exported excel file and there notice the Column No 4 and 5 are not exported.

Could any one help to fix this below code, Attached Dwg file for Reference.

(defun C:WXD  (/
           appname
           col
           data
           en
           header
           item_list
           obj
           result
           row
           spec_list
           ss
           xdv
           xlapp
           xlbook
           xlbooks
           xlcells
           xlsheet
           xlsheets) ;write xdata to Excel


  ;; main part  
  (setq result nil)
  (setq    appname    (getstring T
               "\nEnter the name of extension application (case-nonsensitive): "))
  (setq ss (ssget "_X" (list (list -3 (list appname)))))
  (while (setq en (ssname ss 0))
    (setq obj (vlax-ename->vla-object (ssname ss 0)))
    (vla-getXdata
      obj
      appname
      'xtp
      'xdv
      )

    (setq data
       (mapcar 'vlax-variant-value
           (vlax-safearray->list xdv)
           )
      )
    (setq spec_list (cons (list (cadr data) (caddr data) (cadddr data))
              spec_list))
    (ssdel en ss))
  ;; Excel part

  (or (vl-load-com))


  (alert "Just Close Excel, Nothing Else")
  (setq    xlApp     (vlax-get-or-create-object "Excel.Application")
    xlBooks     (vlax-get-property xlApp "Workbooks")
    xlBook     (vlax-invoke-method xlBooks "Add")
    xlSheets (vlax-get-property xlBook "Sheets")
    xlSheet     (vlax-get-property xlSheets "Item" 1)
    xlCells     (vlax-get-property xlSheet "Cells")
    )


  (vla-put-visible xlApp :vlax-true)
  (setq row 1)
  (setq col 1)
  (setq header '("Column1" "Column2"));<-- change header names to your suit
  (repeat (length header)
    (vlax-put-property
      xlCells
      "Item"
      row
      col
      (vl-princ-to-string (car header))
      )
    (setq header (cdr header))
    (setq col (1+ col))
    )
  (setq    row 2
    col 1
    )
  (repeat (length spec_list)
    (setq item_list (car spec_list))

    (repeat (length item_list)
      (vlax-put-property
    xlCells
    "Item"
    row
    col
    (vl-princ-to-string (car item_list))
    )
      (setq item_list (cdr item_list))
      (setq col (1+ col))
      )
    (setq spec_list (cdr spec_list))
    (setq col 1
      row (1+ row)
      )
    )

  (vlax-invoke-method
    xlBook
    'SaveAs
    (strcat (getvar "dwgprefix")
        (vl-string-right-trim ".dwg" (getvar "dwgname"))
        )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
    )
  (vlax-release-object xlCells)
  (vlax-release-object xlSheet)
  (vlax-release-object xlSheets)
  (vlax-release-object xlBook)
  (vlax-release-object xlBooks)
  (vlax-release-object xlApp)
  (setq xlApp nil)
  (gc)
  (gc)
  (princ)
  )
(princ "\nStart command with WXD...")
(princ)

[dbroad]

Always add the source as a comment to your code so that you can both give credit and find it again.  It is an extremely easy search to find.  http://forums.augi.com/archive/index.php/t-84767.html

Just change the line commented for headers to use the header names and the number of headers you want.

(setq header '("Column1" "Column2"));<-- change header names to your suit

[karunakaran1991]

Hi dboard

The same error happening, Only 3 column are exported other than that all cells are empty. The Header Row is fine and clear

Could u review the code?

[dbroad · Accepted solution]

(defun C:WXD  (/
           appname
           col
           data
           en
           header
           item_list
           obj
           result
           row
           spec_list
           ss
           xdv
           xlapp
           xlbook
           xlbooks
           xlcells
           xlsheet
           xlsheets) ;write xdata to Excel


  ;; main part  
  (setq result nil)
  (setq    appname    (getstring T
               "\nEnter the name of extension application (case-nonsensitive): "))
  (setq ss (ssget "_X" (list (list -3 (list appname)))))
  (while (setq en (ssname ss 0))
    (setq obj (vlax-ename->vla-object (ssname ss 0)))
    (vla-getXdata
      obj
      appname
      'xtp
      'xdv
      )

    (setq data
       (mapcar 'vlax-variant-value
           (vlax-safearray->list xdv)
           )
      )
    (setq spec_list (cons (cdr data) spec_list)) ;;<-This line was limiting the output to 3 items each.
    (ssdel en ss))
  ;; Excel part

  (or (vl-load-com))


  (alert "Just Close Excel, Nothing Else")
  (setq    xlApp     (vlax-get-or-create-object "Excel.Application")
    xlBooks     (vlax-get-property xlApp "Workbooks")
    xlBook     (vlax-invoke-method xlBooks "Add")
    xlSheets (vlax-get-property xlBook "Sheets")
    xlSheet     (vlax-get-property xlSheets "Item" 1)
    xlCells     (vlax-get-property xlSheet "Cells")
    )


  (vla-put-visible xlApp :vlax-true)
  (setq row 1)
  (setq col 1)
  (setq header '("Column1" "Column2" "Column3" "Column4""Column5"));<-- change header names to your suit
  (repeat (length header)
    (vlax-put-property
      xlCells
      "Item"
      row
      col
      (vl-princ-to-string (car header))
      )
    (setq header (cdr header))
    (setq col (1+ col))
    )
  (setq    row 2
    col 1
    )
  (repeat (length spec_list)
    (setq item_list (car spec_list))

    (repeat (length item_list)
      (vlax-put-property
    xlCells
    "Item"
    row
    col
    (vl-princ-to-string (car item_list))
    )
      (setq item_list (cdr item_list))
      (setq col (1+ col))
      )
    (setq spec_list (cdr spec_list))
    (setq col 1
      row (1+ row)
      )
    )

  (vlax-invoke-method
    xlBook
    'SaveAs
    (strcat (getvar "dwgprefix")
        (vl-string-right-trim ".dwg" (getvar "dwgname"))
        )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
    )
  (vlax-release-object xlCells)
  (vlax-release-object xlSheet)
  (vlax-release-object xlSheets)
  (vlax-release-object xlBook)
  (vlax-release-object xlBooks)
  (vlax-release-object xlApp)
  (setq xlApp nil)
  (gc)
  (gc)
  (princ)
  )
(princ "\nStart command with WXD...")
(princ)

 Try this

[karunakaran1991]

Hi dbroad
I got it and thanks for your precious shares and time.

[tech3design]

How would you add area measurements to this lisp for each layer? 

[tech3design]

How can I add the area and the layer to this output?

[devitg]

You can use data extraction 

[tech3design]

yes, I know , but I need the xdata for each.