Chuyển đến nội dung
Diễn đàn CADViet
thanhnv

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

Bởi thanhnv , trong AutoLisp

Các bài được khuyến nghị

Snowman    92

Snowman
Đã đăng

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

  • Vote tăng 4

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ndtnv    481

ndtnv
Đã đăng
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)   ...	)

là

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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

trungputin2003    0

trungputin2003
Đã đăng

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.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

trinhngoctri    0

trinhngoctri
Đã đăng

 

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)   ...	)
là

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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ledinhduong90    0

ledinhduong90
Đã đăng

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 "

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

just4onlyyou    1

just4onlyyou
Đã đăng

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)



			
		


		

			
				
					

	
	
		

			
				
				

					
				

			
			
			
		

	


				
			
			
    
				
					
					
					
				
				
  • 
					
				
    • 
			

		


		
	


	

		

			
Chia sẻ bài đăng này

			

			
Liên kết tới bài đăng

			
			
			

			
				
Chia sẻ trên các trang web khác

				

	

			
		

	



	



					
				
					
					
					







	

	

		

			
just4onlyyou
			  

	
		
	
			 1
	
		
	

		

		

			


	
		just4onlyyou
	

		

	

	
	

		



	

	

		

			
		


		

			Đã đăng  
			
				
				
			
		

	


	


	

		
		

			

http://www.cadviet.com/upfiles/5/144276_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.



			
		


		

			
				
					

	
	
		

			
				
				

					
				

			
			
			
		

	


				
			
			
    
				
					
					
					
				
				
  • 
					
				
    • 
			

		


		
	


	

		

			
Chia sẻ bài đăng này

			

			
Liên kết tới bài đăng

			
			
			

			
				
Chia sẻ trên các trang web khác

				

	

			
		

	



	



					
				
					
					
					






					
				
					
					
					







	

	

		

			
chien_lv
			  

	
		
	
			 7
	
		
	

		

		

			


	
		chien_lv
	

		

	

	
	

		



	

	

		

			
		


		

			Đã đăng  
			
				
				
			
		

	


	


	

		
		

			



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



			
		


		

			
				
					

	
	
		

			
				
				

					
				

			
			
			
		

	


				
			
			
    
				
					
					
					
				
				
  • 
					
				
    • 
			

		


		
	


	

		

			
Chia sẻ bài đăng này

			

			
Liên kết tới bài đăng

			
			
			

			
				
Chia sẻ trên các trang web khác

				

	

			
		

	



	



					
				
			
			



		

	


	

	
		
		

			
				
				





	
	
		

			
				
Tạo một tài khoản hoặc đăng nhập để nhận xét

				
Bạn cần phải là một thành viên để lại một bình luận

			
	
			

				

					

						
Tạo tài khoản

						
Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

						
							
						
						Đăng ký tài khoản mới
					

					

						
Đăng nhập

						
Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

						Đăng nhập ngay
					

				

			

		

	


			
		

	

	
		

			


		

		

			



		

	







	

		
			
				Về Đầu Trang
				AutoLisp
			
		
	

	




	

	

	




						


					

					


					

				

			

			
		

		
		


	×