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)
Solved! Go to Solution.
Solved by dbroad. Go to Solution.
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
(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
How would you add area measurements to this lisp for each layer?
Can't find what you're looking for? Ask the community or share your knowledge.