Đến nội dung


Hình ảnh
* * * * * 1 Bình chọn

Xin lisp xuất bảng tổng hợp khối lượng sang excel


  • Please log in to reply
13 replies to this topic

#1 thanhnv

thanhnv

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 16 October 2008 - 05:28 PM

Mình cần lisp xuất bảng tổng hợp khối lượng sang excel theo nhiều hàng, cột
  • 0

#2 Snowman

Snowman

    biết lệnh mirror

  • Members
  • PipPipPip
  • 155 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 16 October 2008 - 11:24 PM

Xin giới thiệu với các bác đoạn lisp mà em mày mò mãi (với VBA thì vấn đề có vẻ đơn giản (các bác cao thủ nói vậy chứ em chưa thực hành VBA nhiều lắm) nhưng để làm "thuần lisp" thì phải ...tốn công fu hơn :leluoi:
Lệnh e2x: chọn các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)
Kết quả: file xuất ra dưới dạng "giả excel" (Lisp chỉ làm được đến thế này thôi, bạn fải thêm một công ...open & save as --> Thành excel xịn ngay)
(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)

;;;=========================================================================
(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)

(defun boc1chu (ob)
(if (/= ob nil)
(progn
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
)
)


(defun Txtnum (num)
(if (> num 0)
(strcat "+" (rtos num 2 0))
(rtos num 2 0)
)
)
;;;=================================
(defun Txtint (num)
(rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr / obtmp)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr)
obtmp (entmod (subst newstr txtstr Ob))
)
(entupd (cdr (assoc -1 obtmp)))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . "<OR") (0 . "text") (0 . "mtext") (0 . "ATTRIB") (-4 . "OR>"))
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))


;;;====================================================================
;;; Ham kiem tra xem mot so co nam trong day so ko voi sai so cho san
(defun memberp (num listn tsaiso / cter ni ntest test)
(setq cter 0
test nil
)
(while (< cter (length listn))
(setq ntest (nth cter listn)
sstest (abs (- num ntest))
)
(if (<= sstest tsaiso)
(setq cter (length listn)
test T
)
(setq cter (1+ cter))
)
)
(if test
(setq ntest ntest)
(setq ntest nil)
)
(setq ntest ntest)
)

;;;=======================================================================
;;;;=============================================================
;;; Chep du lieu bang ra file xls (du lieu lon xon khong thang hang cot)
(defun C:e2x (/ Txtline txtfile nrow ncol Filedir count count1 Cpright)
(setvar "cmdecho" 0)
(setq OldLay (getvar "Clayer"))

(Setq Cpright
"Copyright by NguyÔn Gia §¹t <Datnggia@gmail.com - 0915169886>"
)
(setq sstab (chonchu "\nChon bang du lieu ...")
sstmp sstab
cter 0
nn (sslength sstmp)
tabdata '()
htext 0
)

;;; loc ra bang du lieu
(while (< cter nn)
(setq objtxt (entget (ssname sstmp cter))
content (cdr (assoc 1 objtxt))
htext (+ htext (cdr (assoc 40 objtxt)))
objtype (cdr (assoc 0 objtxt))
)
(if (= objtype "TEXT")
(progn
(setq just (cdr (assoc 72 objtxt))
)
(if (= just 0)
(setq idtxt (cdr (assoc 10 objtxt)))
(setq idtxt (cdr (assoc 11 objtxt)))
)
)
(setq idtxt (cdr (assoc 10 objtxt)))
)
(setq
objdata (list content idtxt)
tabdata (append tabdata (list objdata))
cter (1+ cter)
)
)

;;; Tim so hang , so cot cua bang du lieu

(setq cter 0
saiso (* 5 (/ htext nn))
xlist '()
ylist '()
)
(repeat nn
(setq objdata (nth cter tabdata)
Pobj (car (cdr objdata))
xobj (car Pobj)
yobj (cadr Pobj)

cter (1+ cter)

)
(if (not (memberp yobj ylist (* saiso 0.1)))
(setq ylist (append ylist (list yobj)))
)
(if (not (memberp xobj xlist saiso))
(setq xlist (append xlist (list xobj)))
)
)
(setq
ncol (length xlist)
nrow (length ylist)
)
;;; Sap xep toa do x, y theo thu tu
(setq xlist (vl-sort xlist '<)
ylist (vl-sort ylist '>)
)

;;; Sap xep du lieu bang thanh hang, cot
(setq tabdata
(vl-sort tabdata
(function (lambda (objdata1 objdata2)
(< (cadr (car (cdr objdata1)))
(cadr (car (cdr objdata2)))
)
)
)
)
)
;;; Chia bang du lieu thanh hang, cot
(setq txtfile '()
ctrow 0


)
(repeat nrow
(setq txtline '()
yrow (nth ctrow ylist)
ctrow (1+ ctrow)

)

(setq txtrow '()
xlistrow '()
cter 0
)
(repeat nn
(setq txtobj (nth cter tabdata)
xobj (car (cadr txtobj))
yobj (cadr (cadr txtobj))
cter (1+ cter)
)
(if (<= (abs (- yrow yobj)) (* 0.1 saiso))
(setq txtrow (append txtrow (list txtobj))
xlistrow (append xlistrow (list xobj))
)
)
)
(setq txtrow
(vl-sort txtrow
(function (lambda (objdata1 objdata2)
(< (car (car (cdr objdata1)))
(car (car (cdr objdata2)))
)
)
)
)
)
(setq ctcol 0
cter1 0)
(repeat ncol
(setq
xcol (nth ctcol xlist)
txtobj (nth cter1 txtrow)
ctcol (1+ ctcol)
cter1 (1+ cter1)
)
(if (memberp xcol xlistrow saiso)
(setq content (strcat (car txtobj) "\t")
)
(setq content (strcat " " "\t")
cter1 (1- cter1))
)

(setq txtline (append txtline (list content))
)

)
(setq txtfile (append txtfile (list txtline)))
)

;;; Chon file luu so lieu

(Setq FileDir (getfiled "File luu so lieu:" "" "xls" 1)
)


(setq cter 0
count (length txtfile)
FileID (open FileDir "w")
)
(write-line "B¶ng d÷ liÖu trÝch xuÊt tõ AutoCAD" FileID)
;(write-line "Stt\tTªn nót\tTo¹ ®é X\tTo¹ ®é Y" FileID)
(while (< cter count)
(setq Txtline (nth cter txtfile)
cter (1+ cter)
cter1 0
content ""
)
(repeat ncol
(setq Content (strcat content (nth cter1 txtline))
cter1 (1+ cter1)
)
)
(setq txtline content)
(write-line Txtline FileID)
)
(write-line Cpright FileID)

(close FileID)
(princ)
)

  • 4

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#3 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 27 November 2008 - 04:48 PM

Xin giới thiệu với các bác đoạn lisp mà em mày mò mãi (với VBA thì vấn đề có vẻ đơn giản (các bác cao thủ nói vậy chứ em chưa thực hành VBA nhiều lắm) nhưng để làm "thuần lisp" thì phải ...tốn công fu hơn :leluoi:
Lệnh e2x: chọn các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)
Kết quả: file xuất ra dưới dạng "giả excel" (Lisp chỉ làm được đến thế này thôi, bạn fải thêm một công ...open & save as --> Thành excel xịn ngay)

Mặc dù không dùng, nhưng xem sơ qua thì thấy Lisp này khá hay, viết ra chắc cũng khá công phu, nhưng có vài chỗ có thể rút gọn:
Để chọn 1 chữ, do không cần lấy điểm chọn thì chỉ cần
	(ssget  ":S" '((-4 . "")))
hoặc có thể thay
	(if test
(setq ntest ntest)
(setq ntest nil)
)
(setq ntest ntest)
bằng
	(if test ntest nil)
Dùng 1 số hàm có sẵn của Lisp VD Thay cho
	(setq sstest (abs (- num ntest)))
(if (<= sstest tsaiso) ... )

	(if (equal  num ntest tsaiso )	...	)

Trong trường hợp 2 text khá dài có "Horizontal text justification type" khác nhau
thì (assoc 10) sẽ cho kết quả chính xác hơn là (assoc 11)
do đó nếu chỉ lấy tọa độ của text thì chỉ cần (assoc 10)
còn (assoc 11) dùng khi thay đổi vị trí text khi (assoc 72) hoặc (assoc 73) khác 0.
  • 0

#4 TID

TID

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 17 December 2012 - 03:30 PM

file xuất ra nằm ở đâu vậy các bác. tìm hoài ko thấy
  • 0

#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 17 December 2012 - 04:34 PM

file xuất ra nằm ở đâu vậy các bác. tìm hoài ko thấy

Hề hề hề,
File xuất ra nằm ở chỗ bạn chọn khi dùng hàm getfiled.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 trungputin2003

trungputin2003

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 July 2014 - 03:02 PM

nhờ các Bác giúp em với.

Em đang có vấn đề là:

Bản vẽ em có rất nhiều text em muốn xuất các text này sang Excel để sửa cho nhanh, sau đó nhập lại  vào cad các text mới này thay text cũ (các text vẫn đúng vị trí nhưng thay đổi giá trị) 

Chân thành Cảm ơn các Bác nhiều nha.


  • 0

#7 sesshoumaru_tqb

sesshoumaru_tqb

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 17 September 2014 - 09:14 AM

bạn ơi cho mình hỏi tại sao mình xuất từ cad sang excel lại bị lỗi không đọc được. Mình đang xài cad 2005


  • 0

#8 sesshoumaru_tqb

sesshoumaru_tqb

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 17 September 2014 - 09:41 AM

Cho mình hỏi thêm cái lisp này có xuất được bảng từ hs sang excel ko vậy bạn ?


  • 0

#9 trinhngoctri

trinhngoctri

    biết vẽ pline

  • Members
  • PipPip
  • 62 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 November 2014 - 10:52 AM

Mặc dù không dùng, nhưng xem sơ qua thì thấy Lisp này khá hay, viết ra chắc cũng khá công phu, nhưng có vài chỗ có thể rút gọn:
Để chọn 1 chữ, do không cần lấy điểm chọn thì chỉ cần

(ssget  ":S" '((-4 . "<OR") (0 . "text") (0 . "mtext") (0 . "ATTRIB") (-4 . "OR>")))
hoặc có thể thay
(if test
		(setq ntest ntest)
		(setq ntest nil)
	)
	(setq ntest  ntest)
bằng
(if test ntest nil)
Dùng 1 số hàm có sẵn của Lisp VD Thay cho
(setq sstest (abs (- num ntest)))
	(if (<= sstest tsaiso)   ...	)

(if (equal  num ntest tsaiso )	...	)
Trong trường hợp 2 text khá dài có "Horizontal text justification type" khác nhau
thì (assoc 10) sẽ cho kết quả chính xác hơn là (assoc 11)
do đó nếu chỉ lấy tọa độ của text thì chỉ cần (assoc 10)
còn (assoc 11) dùng khi thay đổi vị trí text khi (assoc 72) hoặc (assoc 73) khác 0.

bạn làm sao mà khi qua excel nó không bị lỗi phong

ví dụ: họ và tên   Cao Thị Là Uynh (cad) ----->Cao Th\U+1ECB Là Uưnh (excel )


  • 0

#10 ledinhduong90

ledinhduong90

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 July 2015 - 08:57 AM

Xin giới thiệu với các bác đoạn lisp mà em mày mò mãi (với VBA thì vấn đề có vẻ đơn giản (các bác cao thủ nói vậy chứ em chưa thực hành VBA nhiều lắm) nhưng để làm "thuần lisp" thì phải ...tốn công fu hơn leluoi.gif
Lệnh e2x: chọn các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)
Kết quả: file xuất ra dưới dạng "giả excel" (Lisp chỉ làm được đến thế này thôi, bạn fải thêm một công ...open & save as --> Thành excel xịn ngay)

(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)

;;;=========================================================================
(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)

(defun boc1chu (ob)
(if (/= ob nil)
(progn
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
)
)


(defun Txtnum (num)
(if (> num 0)
(strcat "+" (rtos num 2 0))
(rtos num 2 0)
)
)
;;;=================================
(defun Txtint (num)
(rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr / obtmp)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr)
obtmp (entmod (subst newstr txtstr Ob))
)
(entupd (cdr (assoc -1 obtmp)))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . "<OR") (0 . "text") (0 . "mtext") (0 . "ATTRIB") (-4 . "OR>"))
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))


;;;====================================================================
;;; Ham kiem tra xem mot so co nam trong day so ko voi sai so cho san
(defun memberp (num listn tsaiso / cter ni ntest test)
(setq cter 0
test nil
)
(while (< cter (length listn))
(setq ntest (nth cter listn)
sstest (abs (- num ntest))
)
(if (<= sstest tsaiso)
(setq cter (length listn)
test T
)
(setq cter (1+ cter))
)
)
(if test
(setq ntest ntest)
(setq ntest nil)
)
(setq ntest ntest)
)

;;;=======================================================================
;;;;=============================================================
;;; Chep du lieu bang ra file xls (du lieu lon xon khong thang hang cot)
(defun C:e2x (/ Txtline txtfile nrow ncol Filedir count count1 Cpright)
(setvar "cmdecho" 0)
(setq OldLay (getvar "Clayer"))

(Setq Cpright
"Copyright by NguyÔn Gia §¹t <Datnggia@gmail.com - 0915169886>"
)
(setq sstab (chonchu "\nChon bang du lieu ...")
sstmp sstab
cter 0
nn (sslength sstmp)
tabdata '()
htext 0
)

;;; loc ra bang du lieu
(while (< cter nn)
(setq objtxt (entget (ssname sstmp cter))
content (cdr (assoc 1 objtxt))
htext (+ htext (cdr (assoc 40 objtxt)))
objtype (cdr (assoc 0 objtxt))
)
(if (= objtype "TEXT")
(progn
(setq just (cdr (assoc 72 objtxt))
)
(if (= just 0)
(setq idtxt (cdr (assoc 10 objtxt)))
(setq idtxt (cdr (assoc 11 objtxt)))
)
)
(setq idtxt (cdr (assoc 10 objtxt)))
)
(setq
objdata (list content idtxt)
tabdata (append tabdata (list objdata))
cter (1+ cter)
)
)

;;; Tim so hang , so cot cua bang du lieu

(setq cter 0
saiso (* 5 (/ htext nn))
xlist '()
ylist '()
)
(repeat nn
(setq objdata (nth cter tabdata)
Pobj (car (cdr objdata))
xobj (car Pobj)
yobj (cadr Pobj)

cter (1+ cter)

)
(if (not (memberp yobj ylist (* saiso 0.1)))
(setq ylist (append ylist (list yobj)))
)
(if (not (memberp xobj xlist saiso))
(setq xlist (append xlist (list xobj)))
)
)
(setq
ncol (length xlist)
nrow (length ylist)
)
;;; Sap xep toa do x, y theo thu tu
(setq xlist (vl-sort xlist '<)
ylist (vl-sort ylist '>)
)

;;; Sap xep du lieu bang thanh hang, cot
(setq tabdata
(vl-sort tabdata
(function (lambda (objdata1 objdata2)
(< (cadr (car (cdr objdata1)))
(cadr (car (cdr objdata2)))
)
)
)
)
)
;;; Chia bang du lieu thanh hang, cot
(setq txtfile '()
ctrow 0


)
(repeat nrow
(setq txtline '()
yrow (nth ctrow ylist)
ctrow (1+ ctrow)

)

(setq txtrow '()
xlistrow '()
cter 0
)
(repeat nn
(setq txtobj (nth cter tabdata)
xobj (car (cadr txtobj))
yobj (cadr (cadr txtobj))
cter (1+ cter)
)
(if (<= (abs (- yrow yobj)) (* 0.1 saiso))
(setq txtrow (append txtrow (list txtobj))
xlistrow (append xlistrow (list xobj))
)
)
)
(setq txtrow
(vl-sort txtrow
(function (lambda (objdata1 objdata2)
(< (car (car (cdr objdata1)))
(car (car (cdr objdata2)))
)
)
)
)
)
(setq ctcol 0
cter1 0)
(repeat ncol
(setq
xcol (nth ctcol xlist)
txtobj (nth cter1 txtrow)
ctcol (1+ ctcol)
cter1 (1+ cter1)
)
(if (memberp xcol xlistrow saiso)
(setq content (strcat (car txtobj) "\t")
)
(setq content (strcat " " "\t")
cter1 (1- cter1))
)

(setq txtline (append txtline (list content))
)

)
(setq txtfile (append txtfile (list txtline)))
)

;;; Chon file luu so lieu

(Setq FileDir (getfiled "File luu so lieu:" "" "xls" 1)
)


(setq cter 0
count (length txtfile)
FileID (open FileDir "w")
)
(write-line "B¶ng d÷ liÖu trÝch xuÊt tõ AutoCAD" FileID)
;(write-line "Stt\tTªn nót\tTo¹ ®é X\tTo¹ ®é Y" FileID)
(while (< cter count)
(setq Txtline (nth cter txtfile)
cter (1+ cter)
cter1 0
content ""
)
(repeat ncol
(setq Content (strcat content (nth cter1 txtline))
cter1 (1+ cter1)
)
)
(setq txtline content)
(write-line Txtline FileID)
)
(write-line Cpright FileID)

(close FileID)
(princ)
)

 

bác cho em hỏi với ạ : em chọn object rồi nhưng nó báo thế này là bị làm sao vậy bác " bad argument type: stringp nil "


  • 0

#11 just4onlyyou

just4onlyyou

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 10 August 2015 - 01:48 PM

Xin giới thiệu với các bác đoạn lisp mà em mày mò mãi (với VBA thì vấn đề có vẻ đơn giản (các bác cao thủ nói vậy chứ em chưa thực hành VBA nhiều lắm) nhưng để làm "thuần lisp" thì phải ...tốn công fu hơn leluoi.gif
Lệnh e2x: chọn các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)
Kết quả: file xuất ra dưới dạng "giả excel" (Lisp chỉ làm được đến thế này thôi, bạn fải thêm một công ...open & save as --> Thành excel xịn ngay)


 

Mình sử dụng lisp của bạn thấy rất hiệu quả. Xin cảm ơn bạn Snowman 

Nhờ bạn Snowman hoặc bạn nào biết lisp vui lòng sửa lại giúp mình file e2x.lsp chút xíu để công việc nhanh chóng hơn được không ạ.

Mình không biết về lisp nên nhờ bạn sửa lại để khi kết thúc thì sẽ mở excel và mở file vừa xuất luôn (hiện giờ chương trình chỉ lưu file lại, mình phải đến đường dẫn file xuất ra rồi mở lên để thấy kết quả xuất). Cảm ơn các bạn.

 

Trình tự mong muốn:

1. Gõ lệnh.

2. Chọn  các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)

3. Tự động mở chương trình excel và hiện kết quả là các text đã chọn ở dạng bảng (không cần lưu file)


  • 0

#12 just4onlyyou

just4onlyyou

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 12 August 2015 - 08:08 AM

http://www.cadviet.c...44276_e2x_1.lsp

 

Nhờ quý anh quý chị nào biết giúp giùm em với ạ. Em muốn mở rộng lisp để sau khi hoàn tất thì mở chương trình excel và hiện ra kết quả chứ không cần phải đến đường dẫn đã lưu để mở file ạ. Em xin cảm ơn.


  • 0

#13 Vui Bùi 1409

Vui Bùi 1409

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 October 2016 - 03:37 PM

Lisp 


  • 0

#14 chien_lv

chien_lv

    biết vẽ rectang

  • Members
  • PipPip
  • 89 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 20 October 2016 - 05:13 PM

Xin giới thiệu với các bác đoạn lisp mà em mày mò mãi (với VBA thì vấn đề có vẻ đơn giản (các bác cao thủ nói vậy chứ em chưa thực hành VBA nhiều lắm) nhưng để làm "thuần lisp" thì phải ...tốn công fu hơn leluoi.gif
Lệnh e2x: chọn các text sắp xếp theo dạng bảng (ko cần căn thẳng hàng cột)
Kết quả: file xuất ra dưới dạng "giả excel" (Lisp chỉ làm được đến thế này thôi, bạn fải thêm một công ...open & save as --> Thành excel xịn ngay)

(defun myerror (s)
(cond
((= s "quit / exit abort") (princ))
((/= s "Function cancelled") (princ (strcat "\nError: " s)))
)
(setvar "cmdecho" CMD) ; Restore saved modes
(setvar "osmode" OSM)
(setq *error* OLDERR) ; Restore old *error* handler
(princ)
)

;;;=========================================================================
(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)

(defun boc1chu (ob)
(if (/= ob nil)
(progn
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
)
)


(defun Txtnum (num)
(if (> num 0)
(strcat "+" (rtos num 2 0))
(rtos num 2 0)
)
)
;;;=================================
(defun Txtint (num)
(rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr / obtmp)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr)
obtmp (entmod (subst newstr txtstr Ob))
)
(entupd (cdr (assoc -1 obtmp)))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . "<OR") (0 . "text") (0 . "mtext") (0 . "ATTRIB") (-4 . "OR>"))
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))


;;;====================================================================
;;; Ham kiem tra xem mot so co nam trong day so ko voi sai so cho san
(defun memberp (num listn tsaiso / cter ni ntest test)
(setq cter 0
test nil
)
(while (< cter (length listn))
(setq ntest (nth cter listn)
sstest (abs (- num ntest))
)
(if (<= sstest tsaiso)
(setq cter (length listn)
test T
)
(setq cter (1+ cter))
)
)
(if test
(setq ntest ntest)
(setq ntest nil)
)
(setq ntest ntest)
)

;;;=======================================================================
;;;;=============================================================
;;; Chep du lieu bang ra file xls (du lieu lon xon khong thang hang cot)
(defun C:e2x (/ Txtline txtfile nrow ncol Filedir count count1 Cpright)
(setvar "cmdecho" 0)
(setq OldLay (getvar "Clayer"))

(Setq Cpright
"Copyright by NguyÔn Gia §¹t <Datnggia@gmail.com - 0915169886>"
)
(setq sstab (chonchu "\nChon bang du lieu ...")
sstmp sstab
cter 0
nn (sslength sstmp)
tabdata '()
htext 0
)

;;; loc ra bang du lieu
(while (< cter nn)
(setq objtxt (entget (ssname sstmp cter))
content (cdr (assoc 1 objtxt))
htext (+ htext (cdr (assoc 40 objtxt)))
objtype (cdr (assoc 0 objtxt))
)
(if (= objtype "TEXT")
(progn
(setq just (cdr (assoc 72 objtxt))
)
(if (= just 0)
(setq idtxt (cdr (assoc 10 objtxt)))
(setq idtxt (cdr (assoc 11 objtxt)))
)
)
(setq idtxt (cdr (assoc 10 objtxt)))
)
(setq
objdata (list content idtxt)
tabdata (append tabdata (list objdata))
cter (1+ cter)
)
)

;;; Tim so hang , so cot cua bang du lieu

(setq cter 0
saiso (* 5 (/ htext nn))
xlist '()
ylist '()
)
(repeat nn
(setq objdata (nth cter tabdata)
Pobj (car (cdr objdata))
xobj (car Pobj)
yobj (cadr Pobj)

cter (1+ cter)

)
(if (not (memberp yobj ylist (* saiso 0.1)))
(setq ylist (append ylist (list yobj)))
)
(if (not (memberp xobj xlist saiso))
(setq xlist (append xlist (list xobj)))
)
)
(setq
ncol (length xlist)
nrow (length ylist)
)
;;; Sap xep toa do x, y theo thu tu
(setq xlist (vl-sort xlist '<)
ylist (vl-sort ylist '>)
)

;;; Sap xep du lieu bang thanh hang, cot
(setq tabdata
(vl-sort tabdata
(function (lambda (objdata1 objdata2)
(< (cadr (car (cdr objdata1)))
(cadr (car (cdr objdata2)))
)
)
)
)
)
;;; Chia bang du lieu thanh hang, cot
(setq txtfile '()
ctrow 0


)
(repeat nrow
(setq txtline '()
yrow (nth ctrow ylist)
ctrow (1+ ctrow)

)

(setq txtrow '()
xlistrow '()
cter 0
)
(repeat nn
(setq txtobj (nth cter tabdata)
xobj (car (cadr txtobj))
yobj (cadr (cadr txtobj))
cter (1+ cter)
)
(if (<= (abs (- yrow yobj)) (* 0.1 saiso))
(setq txtrow (append txtrow (list txtobj))
xlistrow (append xlistrow (list xobj))
)
)
)
(setq txtrow
(vl-sort txtrow
(function (lambda (objdata1 objdata2)
(< (car (car (cdr objdata1)))
(car (car (cdr objdata2)))
)
)
)
)
)
(setq ctcol 0
cter1 0)
(repeat ncol
(setq
xcol (nth ctcol xlist)
txtobj (nth cter1 txtrow)
ctcol (1+ ctcol)
cter1 (1+ cter1)
)
(if (memberp xcol xlistrow saiso)
(setq content (strcat (car txtobj) "\t")
)
(setq content (strcat " " "\t")
cter1 (1- cter1))
)

(setq txtline (append txtline (list content))
)

)
(setq txtfile (append txtfile (list txtline)))
)

;;; Chon file luu so lieu

(Setq FileDir (getfiled "File luu so lieu:" "" "xls" 1)
)


(setq cter 0
count (length txtfile)
FileID (open FileDir "w")
)
(write-line "B¶ng d÷ liÖu trÝch xuÊt tõ AutoCAD" FileID)
;(write-line "Stt\tTªn nót\tTo¹ ®é X\tTo¹ ®é Y" FileID)
(while (< cter count)
(setq Txtline (nth cter txtfile)
cter (1+ cter)
cter1 0
content ""
)
(repeat ncol
(setq Content (strcat content (nth cter1 txtline))
cter1 (1+ cter1)
)
)
(setq txtline content)
(write-line Txtline FileID)
)
(write-line Cpright FileID)

(close FileID)
(princ)
)

Mình hỏi một chút là nếu tất cả các text  cùng chiều (cùng nghiêng, hoặc cùng đứng thì ok) nhưng nếu không đồng nhất thì nó sẽ không xuất ra được file cho dù nó báo chọn được đối tượng


  • 0