[Đã xong] Lisp xuất dữ liệu từ Acad sang file txt

[vbao 80]

Nhờ các anh trong diễn đàn viết giúp tôi tiện ích xuất dữ liệu từ acad sang file txt, mục đích và yêu cầu xin tham khảo file xuat_dulieu.dwg đính kèm. Chân thành cảm ơn các anh.

http://www.cadviet.com/upfiles/xuat_dulieu.dwg

[Nguyen Hoanh 4.663]

Nhờ các anh trong diễn đàn viết giúp tôi tiện ích xuất dữ liệu từ acad sang file txt, mục đích và yêu cầu xin tham khảo file xuat_dulieu.dwg đính kèm. Chân thành cảm ơn các anh.

http://www.cadviet.com/upfiles/xuat_dulieu.dwg

 

Khi chọn thì như thế nào? phải chọn từng cặp text?

Vì chương trình rất khó phân biệt được text cao độ nào đi với tên điểm nào.

 

VBao có thể chuyển sang dùng block thuộc tính được không? mỗi block thuộc tính có 2 thuộc tính, thuộc tính đầu là cao độ, thuộc tính thứ 2 là tên điểm, điểm chèn block là tọa độ xy. Nếu được như thế, mỗi lần sử dụng chỉ cần bắt một loạt đối tượng là xong.

[vbao 80]

Khi chọn thì như thế nào? phải chọn từng cặp text?

Vì chương trình rất khó phân biệt được text cao độ nào đi với tên điểm nào.

 

VBao có thể chuyển sang dùng block thuộc tính được không? mỗi block thuộc tính có 2 thuộc tính, thuộc tính đầu là cao độ, thuộc tính thứ 2 là tên điểm, điểm chèn block là tọa độ xy. Nếu được như thế, mỗi lần sử dụng chỉ cần bắt một loạt đối tượng là xong.

 

tôi dự định chọn đối tượng theo khung chọn bao hoặc cắt (đối đế có thể chọn từng cặp text), phần text ghi chú theo định dạng của chương trình trong cơ quan chúng tôi lúc nào cũng mặc định có justify là top left (text cao độ có justify là left) và nằm tại vị trí dưới text cao độ với text height = 1/2 text cao độ, có cách nào không anh Hoành?

[Nguyen Hoanh 4.663]

Chương trình dưới có lệnh là ETP, Đáp ứng được yêu cầu của anh Vbao.

Chương trình tự động nhận dạng các text. Chữ to hơn sẽ được xem là cao độ điểm. Chữ bé hơn sẽ được xem là tên điểm.

 

Khi sử dụng chương trình, chỉ cần chọn các đối text, không cần phân biệt đâu là cao độ, đâu là tên điểm.

 

Chương trình có ưu điểm: chấp nhận việc chọn nhầm lẫn với các text không phải là cao độ hay tên điểm (ví dụ là text cao độ hiện trạng), miễn là chiều cao text không trùng với 2 loại này và số đối tượng text tên điểm phải chiếm đa số.

 

(defun c:etp (/ taploai lstent)
 (defun execute (hmax	  hmin	  /	  tapdong pp	  ppmax
	  ppmin	  lstmax  lstmin  pmax	  pmin	  pminluu
	  kcmin	  kcht	  donght
	 )
   (foreach pp	lstent
     (if (= (car pp) hmax)
(setq lstmax (append lstmax (list pp)))
(if (= (car pp) hmin)
  (setq lstmin (append lstmin (list pp)))
)
     )
   )
   (foreach ppmax lstmax
     (setq pmax     (nth 1 ppmax)
    gtmax    (nth 2 ppmax)
    ppminluu nil
     )
     (foreach ppmin lstmin
(setq pmin (nth 1 ppmin)
      kcht (distance pmax pmin)
)
(if (or
      (not ppminluu)
      (> kcmin kcht)
    )
  (setq ppminluu ppmin)
)
     )
     (setq donght  (strcat (rtos (car pmax) 2 3)
		    ","
		    (rtos (cadr pmax) 2 3)
		    ","
		    gtmax
		    ","
		    (nth 2 ppminluu)
	    )
    tapdong (append tapdong (list donght))
    lstmin (vl-remove ppminluu lstmin)
     )
   )
   (setq fname	(getfiled
	  "\nPoint Text Export © CADViet.com - Hay chon ten file"
	  (getvar "DWGNAME")
	  "TXT"
	  1
	)
  fid	(open fname "w")
   )
   (if	fid
     (progn
(foreach donght	tapdong
  (if (not (write-line donght fid))
    (progn
      (princ (strcat "\nLoi khi ghi vao file: " fname))
    )
  )
)
(close fid)
     )
     (princ (strcat "\nKhong the ghi vao file: " fname))
   )
 )
 (defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (cond
   (ss (sslength ss))
   (t 0)
 )
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)
 (defun sosanhloai (e1 e2)
   (    
 )
 (defun chitiet (ent / strh p gt tt)
   (setq
     tt   (entget ent)
     p	   (cdr (assoc 10 tt))
     strh (rtos (cdr (assoc 40 tt)) 2 2)
     gt   (cdr (assoc 1 tt))
   )
   (list strh p gt ent)
 )


 (princ "\nExport Text Point to TXT file © CADViet.com")
 (setq
   sst	   (ssget '((0 . "TEXT")))
   lstent (ss2ent sst)
   lstent (mapcar 'chitiet
	   lstent
   )
 )
 (foreach pp lstent
   (setq loaiht (car pp))
   (if	(setq tmp (assoc loaiht taploai))
     (setq taploai (subst (cons loaiht (1+ (cdr tmp))) tmp taploai))
     (setq taploai (append taploai (list (cons loaiht 1))))
   )
 )
 (setq	taploai	(vl-sort taploai
		 'sosanhloai

	)
loai1	(car taploai)
loai2	(cadr taploai)
 )
 (if (= (cdr loai1)
 (cdr loai2)
     )
   (progn
     (execute (rtos (max (atof (car loai1)) (atof (car loai2))) 2 2)
       (rtos (min (atof (car loai1)) (atof (car loai2))) 2 2)
     )
   )
   (progn
     (princ "\nChuong trinh khong nhan dang duoc text, boi: ")
     (foreach pp taploai
(princ (strcat "\nCo "
	       (itoa (cdr pp))
	       " text voi chieu cao la "
	       (car pp)
       )
)
     )
     (princ
"\nHay chon doi tuong text chi gom 2 kinh co, mot loai to va 1 loai nho!!!"
     )
   )
 )
 (princ)
)
(princ "\nExport Text Point to TXT file © CADViet.com")
(princ "\nSu dung lenh ETP!")
(princ)

[vbao 80]

Chương trình dưới có lệnh là ETP, Đáp ứng được yêu cầu của anh Vbao.

Chương trình tự động nhận dạng các text. Chữ to hơn sẽ được xem là cao độ điểm. Chữ bé hơn sẽ được xem là tên điểm.

 

Khi sử dụng chương trình, chỉ cần chọn các đối text, không cần phân biệt đâu là cao độ, đâu là tên điểm.

 

Chương trình có ưu điểm: chấp nhận việc chọn nhầm lẫn với các text không phải là cao độ hay tên điểm (ví dụ là text cao độ hiện trạng), miễn là chiều cao text không trùng với 2 loại này và số đối tượng text tên điểm phải chiếm đa số.

 

(defun c:etp (/ taploai lstent)
 (defun execute (hmax	  hmin	  /	  tapdong pp	  ppmax
	  ppmin	  lstmax  lstmin  pmax	  pmin	  pminluu
	  kcmin	  kcht	  donght
	 )
   (foreach pp	lstent
     (if (= (car pp) hmax)
(setq lstmax (append lstmax (list pp)))
(if (= (car pp) hmin)
  (setq lstmin (append lstmin (list pp)))
)
     )
   )
   (foreach ppmax lstmax
     (setq pmax     (nth 1 ppmax)
    gtmax    (nth 2 ppmax)
    ppminluu nil
     )
     (foreach ppmin lstmin
(setq pmin (nth 1 ppmin)
      kcht (distance pmax pmin)
)
(if (or
      (not ppminluu)
      (> kcmin kcht)
    )
  (setq ppminluu ppmin)
)
     )
     (setq donght  (strcat (rtos (car pmax) 2 3)
		    ","
		    (rtos (cadr pmax) 2 3)
		    ","
		    gtmax
		    ","
		    (nth 2 ppminluu)
	    )
    tapdong (append tapdong (list donght))
    lstmin (vl-remove ppminluu lstmin)
     )
   )
   (setq fname	(getfiled
	  "\nPoint Text Export © CADViet.com - Hay chon ten file"
	  (getvar "DWGNAME")
	  "TXT"
	  1
	)
  fid	(open fname "w")
   )
   (if	fid
     (progn
(foreach donght	tapdong
  (if (not (write-line donght fid))
    (progn
      (princ (strcat "\nLoi khi ghi vao file: " fname))
    )
  )
)
(close fid)
     )
     (princ (strcat "\nKhong the ghi vao file: " fname))
   )
 )
 (defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (cond
   (ss (sslength ss))
   (t 0)
 )
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)
 (defun sosanhloai (e1 e2)
   (< (car e1) (car e2))

 )
 (defun chitiet (ent / strh p gt tt)
   (setq
     tt   (entget ent)
     p	   (cdr (assoc 10 tt))
     strh (rtos (cdr (assoc 40 tt)) 2 2)
     gt   (cdr (assoc 1 tt))
   )
   (list strh p gt ent)
 )
 (princ "\nExport Text Point to TXT file © CADViet.com")
 (setq
   sst	   (ssget '((0 . "TEXT")))
   lstent (ss2ent sst)
   lstent (mapcar 'chitiet
	   lstent
   )
 )
 (foreach pp lstent
   (setq loaiht (car pp))
   (if	(setq tmp (assoc loaiht taploai))
     (setq taploai (subst (cons loaiht (1+ (cdr tmp))) tmp taploai))
     (setq taploai (append taploai (list (cons loaiht 1))))
   )
 )
 (setq	taploai	(vl-sort taploai
		 'sosanhloai

	)
loai1	(car taploai)
loai2	(cadr taploai)
 )
 (if (= (cdr loai1)
 (cdr loai2)
     )
   (progn
     (execute (rtos (max (atof (car loai1)) (atof (car loai2))) 2 2)
       (rtos (min (atof (car loai1)) (atof (car loai2))) 2 2)
     )
   )
   (progn
     (princ "\nChuong trinh khong nhan dang duoc text, boi: ")
     (foreach pp taploai
(princ (strcat "\nCo "
	       (itoa (cdr pp))
	       " text voi chieu cao la "
	       (car pp)
       )
)
     )
     (princ
"\nHay chon doi tuong text chi gom 2 kinh co, mot loai to va 1 loai nho!!!"
     )
   )
 )
 (princ)
)
(princ "\nExport Text Point to TXT file © CADViet.com")
(princ "\nSu dung lenh ETP!")
(princ)

 

xin chân thành cảm ơn anh Hoành