[编程交流] CAD表格坐标X，Y，Z

(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)