lisp xuất text sang excel có kèm tọa độ

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/70753-nh%E1%BB%9D-ch%E1%BB%89nh-s%E1%BB%ADa-lisp-chuy%E1%BB%83n-cao-%C4%91%E1%BB%99-ra-file-text/
;=======LISP XUAT DIEM DO CAO RA EXCEL=============
;=============KANGKUNG 29/04/2013==================
(defun C:111( / taphop i xlApp xlCells Row TEXT InsertPoint String)
(vl-load-com)
(setq taphop(ssget '((0 . "TEXT"))))
(if (/= taphop nil)
(progn
(setq i 0)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells(vlax-get-property(vlax-get-property(vlax-get-property(vlax-invoke-method(vlax-get-property xlApp 'Workbooks) 'Add) 'Sheets)'Item 1)'Cells)
Row 1)
(while (< i (sslength taphop))
(setq TEXT (entget (ssname taphop i)))
(if (= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT))))
(progn
(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
(setq InsertPoint(cdr(assoc 10 TEXT)))
(setq InsertPoint(cdr(assoc 11 TEXT)))
)
(setq String(cdr(assoc 1 TEXT))) (vlax-put-property xlCells 'Item row 1 (itoa Row)) (vlax-put-property xlCells 'Item row 2 (rtos (car InsertPoint) 2 3))
(vlax-put-property xlCells 'Item row 3 (rtos (cadr InsertPoint) 2 3)) (vlax-put-property xlCells 'Item row 4 (rtos (caddr InsertPoint) 2 3))
(vlax-put-property xlCells 'Item row 5 String) (setq Row (1+ Row))))
(setq i (1+ i)))
(vlax-put-property xlApp 'Visible :vlax-true)))
(princ)
)
(defun C:T2E() (C:Text2Excel))
(princ "\n KangKung - 29/04/2013\n")
(princ "\n Nhap T2E hoac Text2Excel de chay chuong trinh\n")

Mình hay dùng lisp này :

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=52738
[codebox](defun c:exptxt()
(setq ss (ssget '((0 . "TEXT")))
fn (getfiled "Ten file: " "" "txt" 1)
f (open fn "w")
lst (ss2ent ss)
)
(foreach e lst
(setq tt (entget e)
p (cdr (assoc 10 tt))
x (rtos (car p))
y (rtos (cadr p))
nd (cdr (assoc 1 tt))
)
(write-line (strcat x "\t" y "\t" nd ) f)
)
(close f)
(princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq sodt (if ss (sslength ss) 0 )
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)[/codebox]

lisp xuất cao độ ra .txt :
http://www.cadviet.com/upfiles/3/78855_xuat_cao_do_ra_txt.rar

lisp này rẩt hay (tôi đang dùng) chọn tất cả đối tượng rồi xuất ra excel, sang bảng excel tự sắp xếp đối tượng theo thứ tự tọa độ x tăng dần :

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=14938
(defun c:xt()
 (setq ss  (ssget '((0 . "TEXT")))
fn  (getfiled "Ten file: " "" "txt" 1)
f   (open fn "w")
lst (ss2ent ss)
 )
 (foreach e lst
   (setq tt (entget e)
 p  (cdr (assoc 10 tt))
 x  (rtos (car p))
 y  (rtos (cadr p))
 nd  (cdr (assoc 1 tt))
   )
   (write-line (strcat x "\t" y "\t" nd ) f)
 )
 (close f)
 (princ)
)

(defun ss2ent (ss / sodt index lstent)
 (setq sodt (if ss (sslength ss) 0 )
index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
 index (1+ index)
 lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)

;This lisp is developed as part of Survey Drawing project, which aims to help people prepare survey drawings easily.
;You may find more such lisps at www.surveydrawing.net and www.esurveying.net


(defun c:EXyz()
(setq entset(ssget (list (cons 0 "Text"))))
(setq len(sslength entset))
(setq ctr 0)
(setq fileName(getfiled "Specify TXT File Name" "C:\\XYZCode" "TXT" 1))
(setq fileO(open fileName "w"))
(repeat len
(setq ent(ssname entset ctr))
(setq txt(cdr (assoc 1 (entget ent))))
(setq insPO(exins ent))
(setq insX(car insPO))
(setq insY(cadr insPO))
(if (= (length insPO) 3)
(setq insZ(caddr insPO))
(setq insZ 0)
)
(write-line (strcat (rtos insX) "," (rtos insY) "," (rtos insZ) "," txt) fileO)
(setq ctr(1+ ctr))
)
(princ (strcat "\nData exported to '" fileName "'. Open in Excel or Notepad."))
(close fileO)
(princ)
)

;Function to extract the insertion point of a text.
(defun exins(tent)
(setq tdetails(entget tent))
(setq check(assoc 11 tdetails))
(if (= check nil)
(setq check(cdr (assoc 10 tdetails)))
(progn
(setq check(cdr check))
(if (and (= (car check) 0) (= (cadr check) 0))
(setq check(cdr (assoc 10 tdetails)))
(setq check(cdr (assoc 11 tdetails)))
)
)
)
(setq check(list (car check) (cadr check)))
(setq return check)
)

(princ "\nType \"EXyz\" to Export X,Y,Z and Content to File.") (princ)

2 lisp có lệnh xt và EXyz cách dùng như nhau và cho kết quả giống nhau, tôi hay dùng 2 lisp này.