Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 07 August 2007 - 08:25 PM

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
  • 0

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4106 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 07 August 2007 - 08:38 PM

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.
  • 0

#3 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 07 August 2007 - 08:52 PM

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?
  • 0

#4 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4106 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 10 August 2007 - 09:10 AM

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)

  • 0

#5 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 10 August 2007 - 05:01 PM

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
  • 0