Jump to content

CAD table coordinates X, Y, Z into EXCEL?


cadamrao

Recommended Posts

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'~

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...