Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
huunhantvxdts

[Nhờ hoàn thiện lisp] Xuẩt khối lượng trắc ngang qua excel

Bởi huunhantvxdts , trong AutoLisp

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

hoquangvinh    7

hoquangvinh
Đã đăng

Chắc do lỗi của diễn đàn khi download

 bạn làm theo hướng dẫn ở trên kích vào trả lời rồi copy về save thành lisp

mình cũng làm đúng như thế rồi mà sao dừ khi apload lisp nó lại ko nhận nhỉ

bây giờ thì không chạy được lisp nữa luô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

huunhantvxdts    195

huunhantvxdts
Đã đăng

up lại cho bạn 

(defun c:xkl (/ dem1 lstkm point kcach point1 pointtim diemtam xuongdong kt)
(setvar "CMDECHO" 0)
(defun sosanh (e1 e2 / p1 p2)
(setq p1 (car e1)
p2 (car e2)
)
(if (equal (cadr p1) (cadr p2) fuzz)
(< (car p1) (car p2))
(> (cadr p1) (cadr p2))
)
   )
   
(defun inra(lst)
(setq index 1
 oldy nil)
(foreach en lst
(if (equal oldy (cadr (car en)) fuzz)
(progn 
(if (< index 4)
 (progn 
	(princ "," fid) 
	(setq index (1+ index))
	)
 	(progn 
	(setq index 1) 
	(princ "\n" fid)
	)
 )
    )
(progn  
(if hangdau
 (progn (setq index 1) 
(princ "\n" fid))
 (setq hangdau t))
  )
      )
      (princ (cdr en) fid)
      (setq oldy (cadr (car en)))
 )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (prompt "\nChon doi tuong coc hoac ly trinh lam lop chuan.")  
  (setq dtltc (car (entsel)))
  (setq lop1 (cdr (assoc 8 (entget dtltc))))
  (prompt "\nChon doi tuong ghi dien tich lam lop chuan.")
  (setq lop2 (car (entsel)))
  (setq lop2 (cdr (assoc 8 (entget lop2))))
  (prompt "\nChon trac ngang.")
  (setq danhsachkm (acet-ss-to-list (ssget (list (cons 8 lop1) (cons 1 "K*")))))
  (setq lstkm (mapcar '(lambda (e) (cons (cdr (assoc 11 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
  (setq lstkm (vl-sort lstkm '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
                 (or (< (car tmx) (car tmy))
    (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
  (setq ss (acet-ss-to-list (ssget "X" '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq fn (getfiled "Chon file de save" "" "csv" 1))
  (setq fid (open fn "w"))
(setq dem1 1)
(setq sodt (length danhsachkm)
ta 
            (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta 
            ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (foreach ent lstkm
    (setq point (car ent))
    (setq kcach (distance point (cdr (assoc 11 (entget (nth 0 ss))))))
    (foreach enxt ss
      (setq point1 (cdr (assoc 11 (entget enxt))))
      (setq toay (cadr point1))
      (if (and (< (distance point1 point) kcach) (< toay (cadr point)) (equal (car point1) (car point) 1))
(progn
 (setq pointtim (cdr (assoc 11 (entget enxt))))
 (setq kcach (distance pointtim point))
)
      )
    )
    (setq diemtam (polar pointtim (/ pi 2) (/ kcach 2)))
;;; zoom den tung trac ngang nhung khong thay no chay 
;;;; 
    (vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point diemtam) (+ kcach 50))
	;(command "ZOOM" "C" diemtam (+ kcach 20))
    (setq dd (acet-ss-to-list (ssget "C" (polar pointtim (/ pi 4) 0.1 ) (polar pointtim (/ pi -4) 0.1 ) '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
    (setq diemdau (cdr (assoc 10 (entget (car dd)))))
    (setq diemcuoi (cdr (assoc 11 (entget (car dd)))))
    (setq diemtren (polar point (/ pi 2) 50))
    (command ".RECTANGLE" diemdau diemtren)
    (setq text (ssget "C" diemdau diemtren (list (cons 0 "text"))))
    (setq lst0 (ss2ent text lop1))
    (setq lst0 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst0))
    (setq lst2 (ss2ent text lop2))
    (setq lst2 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst2))
    (setq
caotext (cdr (assoc 40 (entget (ssname text 0))))
fuzz (* caotext 1.0)
lst0 (vl-sort lst0 'sosanh)
lst2 (vl-sort lst2 'sosanh)
    )
(setq xuongdong 0)
(if (= kt nil) (setq kt 0))
(foreach em lst0
(if (= kt 0)
(if (= xuongdong 0)
(progn 
(princ (cdr em) fid) 
(princ "\n" fid)
(setq xuongdong 1))
 (if (= xuongdong 1)
   (progn 
	(princ (cdr em) fid) 
	(setq xuongdong 2)
	)
)
)
(if (= xuongdong 0)
(progn 
(princ "\n" fid)
(princ (cdr em) fid) 
(princ "\n" fid)
(setq xuongdong 1))
 (if (= xuongdong 1)
   (progn 
	(princ (cdr em) fid) 
	(setq xuongdong 2)
	)
)
)
)
)
(setq kt 1)
    (inra lst2)
 
    (command ".RECTANGLE" diemcuoi diemtren)
    (setq text1 (ssget "C" diemcuoi diemtren (list (cons 0 "text"))))
    (setq lst3 (ss2ent text1 lop2))
    (setq lst3 (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst3))
    (setq lst3 (vl-sort lst3 'sosanh))
    (inra lst3)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; xu ly phan tram chay o duoi
(setq pt (* (/ (* dem1 1.0) sodt) 100.0)
dem1 (+ dem1 1)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
;(princ "\nDang xu ly")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "MODEMACRO" "DANG CHUYEN DU LIEU CHO TRONG GIAY LAT")  
)
  (if fid (close fid))
(setvar "CMDECHO" 1)
(thoi)
)
 
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase (cdr st)) (+ 3 (vl-string-search "KM" (strcase (cdr st)))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
 
(defun ss2ent (ss lop / sodt index lstent)
  (setq sodt (if ss (sslength ss) 0)
index 0)
  (repeat sodt
    (setq ent (ssname ss index))
    (setq index (1+ index))
    (if (= (cdr (assoc 8 (entget ent))) lop)
      (setq lstent (cons ent lstent))
    )
  )
  (reverse lstent)
)
  • Vote tăng 1

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

hoquangvinh    7

hoquangvinh
Đã đăng

cảm ơn bác chủ đã nhiệt tình theo dõi và up lại lisp

nhưng ko hiểu tại sao mà bây giờ lại ko thể apload lisp để dùng đc nữa

ap xong lệnh: xkl nó hiện lỗi ngay: Unknown command "XKL".  Press F1 for help.

và tất nhiên là chỉ lisp này bị thôi còn các lisp khác mình vẫn load được bình thường

có bác nào gặp trường hợp như thế này chưa nhỉ

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

hoquangvinh    7

hoquangvinh
Đã đăng

he sau một hồi lần mò thì e đã tìm ra lỗi, nó bị như sau các bác ạ:

mở file lisp bằng notepad thì ko bị lỗi gì

mở file lisp bằng Visual lisp Editor thì thấy có 1 kí tự lạ: "Â" hiện đầu tiên gần như tất cả các dòng lệnh (mở cả 2 cái cùng lúc để so sánh thì mới thấy đc)

e xóa hết kí tự này thì lisp chạy được rồi

e đưa lên đây để bác nào bị lỗi thế này thì biết để sửa, sáng đến giờ hoang mang quá

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

he sau một hồi lần mò thì e đã tìm ra lỗi, nó bị như sau các bác ạ:

mở file lisp bằng notepad thì ko bị lỗi gì

mở file lisp bằng Visual lisp Editor thì thấy có 1 kí tự lạ: "Â" hiện đầu tiên gần như tất cả các dòng lệnh (mở cả 2 cái cùng lúc để so sánh thì mới thấy đc)

e xóa hết kí tự này thì lisp chạy được rồi

e đưa lên đây để bác nào bị lỗi thế này thì biết để sửa, sáng đến giờ hoang mang quá

Lỗi này xuất hiện lâu rồi là do lỗi ở phần download của diễn đàn. Mong admin sớm khắc phục

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

hoquangvinh    7

hoquangvinh
Đã đăng

sau khi chạy được lisp thì e thấy vẫn chưa được như ý lắm, còn có một số vấn đề như sau:

1. Trường hợp của bác chủ thì sau khi xuất ra bảng exel vẫn phải viết thêm 1 tiện ích nữa để sắp xếp lại theo thứ tự. Vậy là vấn đề của mình (xuất kl từ tn sang bảng exel) cũng vẫn chưa thực hiện được.

2. Mình xuất KL ra nó chạy lung tung lắm: tên cọc, lý trình và hạng mục sắp xếp ko theo thứ tự nào cả. Thường thì mỗi cái thấy nó xuất hiện 2 lần nhưng cũng ko hẳn là 2 lần đầy đủ, lần thứ 2 nó chỉ xuất ra một số hạng mục xong lại đến cọc khác

3. Có trường hợp thì li sp chạy nhưng kết thúc ko có kết quả gì cả:

 

Command: xkl
Chon doi tuong coc hoac ly trinh lam lop chuan.
Select object:
Chon doi tuong ghi dien tich lam lop chuan.
Select object:
Chon trac ngang.
Select objects: Specify opposite corner: 71 found
Select objects:  ; error: bad argument type: consp nil
Command:

 

Mong bác chủ xem xét lại xem

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

sau khi chạy được lisp thì e thấy vẫn chưa được như ý lắm, còn có một số vấn đề như sau:

1. Trường hợp của bác chủ thì sau khi xuất ra bảng exel vẫn phải viết thêm 1 tiện ích nữa để sắp xếp lại theo thứ tự. Vậy là vấn đề của mình (xuất kl từ tn sang bảng exel) cũng vẫn chưa thực hiện được.

2. Mình xuất KL ra nó chạy lung tung lắm: tên cọc, lý trình và hạng mục sắp xếp ko theo thứ tự nào cả. Thường thì mỗi cái thấy nó xuất hiện 2 lần nhưng cũng ko hẳn là 2 lần đầy đủ, lần thứ 2 nó chỉ xuất ra một số hạng mục xong lại đến cọc khác

3. Có trường hợp thì li sp chạy nhưng kết thúc ko có kết quả gì cả:

 

Command: xkl
Chon doi tuong coc hoac ly trinh lam lop chuan.
Select object:
Chon doi tuong ghi dien tich lam lop chuan.
Select object:
Chon trac ngang.
Select objects: Specify opposite corner: 71 found
Select objects:  ; error: bad argument type: consp nil
Command:

 

Mong bác chủ xem xét lại xem

Bạn cần đưa file đó lên mình mới có hướng dẫn cụ thể còn các vấn đề bạn đưa ra mình đã giải quyết được

Bạn có thể xem video của mình dưới:

https://youtu.be/eI054HozhwQ

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

hôm qua up file lên mà bị lỗi nên hôm nay mình gửi các file mình chạy lên bạn xem qua nhé

https://www.dropbox.com/s/zmbc3a2c9cwskym/Check%20lisp%20XKL.rar?dl=0&s=sl

Theo file bạn gửi thì đã mất block đầu cờ nên không chạy được

còn file excel chạy ra như vậy là đúng rồi đó, có lỗi ở dòng đầu phải chỉnh thủ công lại 1 tí rồi dùng phần mềm viết trên excel lấy xuất khối lượng theo thứ tự như trong clip đã làm

Bạn chưa xem clip thì phải??????

P/S:

file bạn chạy không đúng file chuẩn mình đưa lên, nên cần chỉnh sửa lại 1 tí về layer

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

hoquangvinh    7

hoquangvinh
Đã đăng

mình có xem clip chứ nhưng phần mềm viết trên exel thì làm sao thấy được nội dung, chỉ thấy kết quả của chương trình thôi

cái file bị lỗi ko chạy được là file bị mất đầu cờ rồi, cái file còn lại vẫn chạy được nhưng kết quả thì nó sắp xếp hơi lộn xộn ko giống như cái file mẫu của bạn trên clip. File của mình có đến 2 cột và có thể có 1 vài TN có thể bị lệch cột (lệch: X) nên thứ tự xuất ra bị biến dạng chăng; còn hạng mục đầu tiên của cọc đầu tiên thì nó dính với lý trình thì mình có thấy rồi

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

ceddtu    6

ceddtu
Đã đăng

các thành phần khối lượng của các trắc ngang không giống nhau, nhiều hạng mục trắc ngang này có nhưng trắc ngang kia ko có, vậy khi xuất ra excel thì làm sao tổng hợp đc nhỉ.

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

các thành phần khối lượng của các trắc ngang không giống nhau, nhiều hạng mục trắc ngang này có nhưng trắc ngang kia ko có, vậy khi xuất ra excel thì làm sao tổng hợp đc nhỉ.

Vẫn tính bình thường mà cái nào không có thì khi qua excel nó tính bằng 0

  • Vote tăng 1

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

ceddtu    6

ceddtu
Đã đăng

Vẫn tính bình thường mà cái nào không có thì khi qua excel nó tính bằng 0

Cảm ơn bạn nhé

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
17 giờ trước, batitus đã nói:

@huunhantvxdts bác xem hộ. Em chạy báo lỗi không lấy được khối lượng ra excel.

Kenh tieu.dwg

Cái này định dạng khác file mẫu nên không xuất được. Để xuất được bạn liên hệ: https://www.facebook.com/lienkettudong/

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

kadic309    1

kadic309
Đã đăng
Vào lúc 4/4/2019 tại 14:27, batitus đã nói:

@huunhantvxdts bác xem hộ. Em chạy báo lỗi không lấy được khối lượng ra excel.

Kenh tieu.dwg

Bạn cần làm hai việc

thứ nhất là đổi tên layer EntTNTuNhien thành ENTTNTUNHIEN

Sau đó chạy lisp nó vẽ ra một loạt hình chữ nhật, bạn move text khối lượng vào phạm vi của hình chữ nhật đó

Rồi chạy lisp lần nữa là xong

  • Like 1

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×