cadamrao Posted June 8, 2010 Share Posted June 8, 2010 Hi Any LISP please to convert the CAD table coordinates X, Y, Z into EXCEL? Advance thanks amr Quote Link to comment Share on other sites More sharing options...
fixo Posted June 8, 2010 Share Posted June 8, 2010 Hi Any LISP please to convert the CAD table coordinates X, Y, Z into EXCEL? Advance thanks amr Try something like this (vl-load-com) ;; local defuns (defun get_table_content (atable / col cols data datum hastile row rows start tmp ) (setq cols (vla-get-columns atable) rows (vla-get-rows atable) start rows ) (if (eq :vlax-true (vla-get-titlesuppressed atable)) (progn (setq rows (1- rows)) (setq hastile T) (setq hastile nil) ) ) (if (eq :vlax-true (vla-get-headersuppressed atable)) (setq rows (1- rows)) ) (setq row (- start rows)) (repeat rows (setq col 0) (repeat cols (setq datum (vla-gettext atable row col)) (setq tmp (cons datum tmp)) (setq col (1+ col)) ) (setq data (cons (reverse tmp) data) tmp nil row (1+ row) ) ) (setq data (reverse data)) (if hastile (setq data (append (list (caar data) (cdr data)))) ) data ) (defun merge_first_row (xlsht columns / adr rng) (setq adr (strcat "A1:" (chr (+ 65 (1- columns))) "1")) (setq rng (vlax-get-property xlsht 'Range adr)) (vlax-put-property rng 'HorizontalAlignment (vlax-make-variant -4108 vlax-vbinteger) ) ;1 (vlax-put-property rng 'VerticalAlignment (vlax-make-variant -4107 vlax-vbinteger) ) ;2 (vlax-put-property rng 'WrapText (vlax-make-variant -1 11)) ;3 (vlax-put-property rng 'Orientation (vlax-make-variant -4128 vlax-vbinteger) ) ;4 (vlax-put-property rng 'AddIndent (vlax-make-variant -1 11)) ;5 (vlax-put-property rng 'IndentLevel (vlax-make-variant 0 vlax-vbinteger) ) ;6 (vlax-put-property rng 'ShrinkToFit (vlax-make-variant -1 11) ) ;7 (vl-catch-all-apply (function (lambda () (vlax-put-property rng 'MergeCells (vlax-make-variant -1 11) ) ) ) ) ;8 (vlax-put-property rng 'ReadingOrder (vlax-make-variant -5002 vlax-vbinteger) ) ;9 (vlax-invoke rng 'Merge) (vlax-release-object rng) (setq rng nil) ) (defun draw-grid (xlapp xlsht / a bords cnt rng sel) (setq rng (vlax-get-property xlsht 'UsedRange)) (vlax-invoke-method rng 'Select) (setq sel (vlax-get-property xlapp 'Selection)) (setq bords (vlax-get-property sel "Borders")) ;; iterate through all edges of selection (setq cnt 0) (vlax-for a bords (setq cnt (1+ cnt)) (vl-catch-all-apply (function (lambda () (progn (if (< cnt 5) (progn (vlax-put-property a "LineStyle" (vlax-make-variant 1 3) ) (vlax-put-property a "Weight" (vlax-make-variant 4 3) ) (vlax-put-property a "ColorIndex" (vlax-make-variant 5 5) ) ) ;progn ;; turn off the diagonal lines: (vlax-put-property a "LineStyle" (vlax-make-variant -4142 3) ) ) ) ) ) ) ) (vlax-release-object rng) (vlax-release-object sel) ) ;; main part ;; based on rouitine written by Alejandro Leguizamon (defun C:LX (/ adoc atable col columns data en ent merged row rows xlapp xlbks xlcls xlcols xlrng xlsht xlshts xlwbk ) (or (vl-load-com)) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (setq ent (entsel "\nSelect table >>")) (equal "ACAD_TABLE" (cdr (assoc 0 (entget (setq en (car ent)))) ) ) ) (progn (setq atable (vlax-ename->vla-object en)) (setq data (get_table_content atable)) (setq xlapp (vlax-get-or-create-object "Excel.Application") xlbks (vlax-get-property xlapp "Workbooks") xlwbk (vlax-invoke-method xlbks "Add") xlshts (vlax-get-property xlwbk "Sheets") xlsht (vlax-get-property xlshts "Item" 1) xlcls (vlax-get-property xlsht "Cells") ) (vla-put-visible xlapp :vlax-true) (setq row 0) (setq columns (length (last data)) rows (length data) ) (if (= 1 (length (vl-remove-if (function (lambda(x)(equal "" x)))(car data)))) (setq merged T) (setq merged nil) ) (if merged (progn (setq row (1+ row)) (vlax-put-property xlcls "Item" row 1 (vl-princ-to-string (caar data)) ) (setq data (cdr data)) (foreach lst data (setq row (1+ row) col 1 ) (foreach itm lst (vlax-put-property xlcls "Item" row col (vl-princ-to-string itm) ) (setq col (1+ col)) ) ) (merge_first_row xlsht columns) ) (progn (setq row 0) (foreach lst data (setq row (1+ row) col 1 ) (foreach itm lst (vlax-put-property xlcls "Item" row col (vl-princ-to-string itm) ) (setq col (1+ col)) ) ) ) ) (draw-grid xlapp xlsht) (setq xlrng (vlax-get-property xlsht 'UsedRange)) (setq xlcols (vlax-get-property xlrng 'Columns)) (vlax-invoke-method xlcols 'AutoFit) (vlax-invoke-method xlwbk 'SaveAs (strcat (getvar "dwgprefix") "List.xls") -4143 nil nil :vlax-false :vlax-false 1 2 ) (vlax-release-object xlcls) (vlax-release-object xlsht) (vlax-release-object xlshts) (vlax-release-object xlwbk) (vlax-release-object xlbks) (vlax-release-object xlapp) (setq xlapp nil) (alert "Excel File Was Saved. Close Excel Manually") ) ) (gc) (gc) (gc) (princ) ) (princ "\n===========================\n") (princ "\n Start with LX to run ...") (princ "\n===========================\n") (princ) ~'J'~ Quote Link to comment Share on other sites More sharing options...
cadamrao Posted June 9, 2010 Author Share Posted June 9, 2010 Try something like this (vl-load-com) ;; local defuns (defun get_table_content (atable / col cols data datum hastile row rows start tmp ) (setq cols (vla-get-columns atable) rows (vla-get-rows atable) start rows ) (if (eq :vlax-true (vla-get-titlesuppressed atable)) (progn (setq rows (1- rows)) (setq hastile T) (setq hastile nil) ) ) (if (eq :vlax-true (vla-get-headersuppressed atable)) (setq rows (1- rows)) ) (setq row (- start rows)) (repeat rows (setq col 0) (repeat cols (setq datum (vla-gettext atable row col)) (setq tmp (cons datum tmp)) (setq col (1+ col)) ) (setq data (cons (reverse tmp) data) tmp nil row (1+ row) ) ) (setq data (reverse data)) (if hastile (setq data (append (list (caar data) (cdr data)))) ) data ) (defun merge_first_row (xlsht columns / adr rng) (setq adr (strcat "A1:" (chr (+ 65 (1- columns))) "1")) (setq rng (vlax-get-property xlsht 'Range adr)) (vlax-put-property rng 'HorizontalAlignment (vlax-make-variant -4108 vlax-vbinteger) ) ;1 (vlax-put-property rng 'VerticalAlignment (vlax-make-variant -4107 vlax-vbinteger) ) ;2 (vlax-put-property rng 'WrapText (vlax-make-variant -1 11)) ;3 (vlax-put-property rng 'Orientation (vlax-make-variant -4128 vlax-vbinteger) ) ;4 (vlax-put-property rng 'AddIndent (vlax-make-variant -1 11)) ;5 (vlax-put-property rng 'IndentLevel (vlax-make-variant 0 vlax-vbinteger) ) ;6 (vlax-put-property rng 'ShrinkToFit (vlax-make-variant -1 11) ) ;7 (vl-catch-all-apply (function (lambda () (vlax-put-property rng 'MergeCells (vlax-make-variant -1 11) ) ) ) ) ;8 (vlax-put-property rng 'ReadingOrder (vlax-make-variant -5002 vlax-vbinteger) ) ;9 (vlax-invoke rng 'Merge) (vlax-release-object rng) (setq rng nil) ) (defun draw-grid (xlapp xlsht / a bords cnt rng sel) (setq rng (vlax-get-property xlsht 'UsedRange)) (vlax-invoke-method rng 'Select) (setq sel (vlax-get-property xlapp 'Selection)) (setq bords (vlax-get-property sel "Borders")) ;; iterate through all edges of selection (setq cnt 0) (vlax-for a bords (setq cnt (1+ cnt)) (vl-catch-all-apply (function (lambda () (progn (if (< cnt 5) (progn (vlax-put-property a "LineStyle" (vlax-make-variant 1 3) ) (vlax-put-property a "Weight" (vlax-make-variant 4 3) ) (vlax-put-property a "ColorIndex" (vlax-make-variant 5 5) ) ) ;progn ;; turn off the diagonal lines: (vlax-put-property a "LineStyle" (vlax-make-variant -4142 3) ) ) ) ) ) ) ) (vlax-release-object rng) (vlax-release-object sel) ) ;; main part ;; based on rouitine written by Alejandro Leguizamon (defun C:LX (/ adoc atable col columns data en ent merged row rows xlapp xlbks xlcls xlcols xlrng xlsht xlshts xlwbk ) (or (vl-load-com)) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (if (and (setq ent (entsel "\nSelect table >>")) (equal "ACAD_TABLE" (cdr (assoc 0 (entget (setq en (car ent)))) ) ) ) (progn (setq atable (vlax-ename->vla-object en)) (setq data (get_table_content atable)) (setq xlapp (vlax-get-or-create-object "Excel.Application") xlbks (vlax-get-property xlapp "Workbooks") xlwbk (vlax-invoke-method xlbks "Add") xlshts (vlax-get-property xlwbk "Sheets") xlsht (vlax-get-property xlshts "Item" 1) xlcls (vlax-get-property xlsht "Cells") ) (vla-put-visible xlapp :vlax-true) (setq row 0) (setq columns (length (last data)) rows (length data) ) (if (= 1 (length (vl-remove-if (function (lambda(x)(equal "" x)))(car data)))) (setq merged T) (setq merged nil) ) (if merged (progn (setq row (1+ row)) (vlax-put-property xlcls "Item" row 1 (vl-princ-to-string (caar data)) ) (setq data (cdr data)) (foreach lst data (setq row (1+ row) col 1 ) (foreach itm lst (vlax-put-property xlcls "Item" row col (vl-princ-to-string itm) ) (setq col (1+ col)) ) ) (merge_first_row xlsht columns) ) (progn (setq row 0) (foreach lst data (setq row (1+ row) col 1 ) (foreach itm lst (vlax-put-property xlcls "Item" row col (vl-princ-to-string itm) ) (setq col (1+ col)) ) ) ) ) (draw-grid xlapp xlsht) (setq xlrng (vlax-get-property xlsht 'UsedRange)) (setq xlcols (vlax-get-property xlrng 'Columns)) (vlax-invoke-method xlcols 'AutoFit) (vlax-invoke-method xlwbk 'SaveAs (strcat (getvar "dwgprefix") "List.xls") -4143 nil nil :vlax-false :vlax-false 1 2 ) (vlax-release-object xlcls) (vlax-release-object xlsht) (vlax-release-object xlshts) (vlax-release-object xlwbk) (vlax-release-object xlbks) (vlax-release-object xlapp) (setq xlapp nil) (alert "Excel File Was Saved. Close Excel Manually") ) ) (gc) (gc) (gc) (princ) ) (princ "\n===========================\n") (princ "\n Start with LX to run ...") (princ "\n===========================\n") (princ) ~'J'~ Great working! Thanks laa.. amr Quote Link to comment Share on other sites More sharing options...
fixo Posted June 9, 2010 Share Posted June 9, 2010 You're welcome ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.