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

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

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

Đây là lisp mình mày mò viết nhờ trợ giúp trên diễn đàn. Về cơ bản là đã chạy đúng nhưng chưa ưng ý lắm.

1. Muốn nó zoom đến từng trắc ngang để có thể quan sát được số liệu (cái này chỉ liếc qua thôi đã thấy), Bởi có quá nhiều trắc ngang quá nên tìm dễ sót (Cái này đã vấp phải).

2. Muốn có dòng % đang xử lý ở dòng lệnh.

Hai cái trên mình cũng đã viết nhưng không thây nó chạy chi cả, mong mọi người quan tâm giúp đỡ.

Cám ơn mọi người nhiều!

đây là lisp

(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 20))
;(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) 10))
    (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)
)
 

còn đây là file kiểm tra

http://www.cadviet.com/upfiles/4/66960_trac_ngang_in__updte_new_pkdc.dwg

  • 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

Thật ra nó có làm hết đó chứ, có điều nó làm nhanh quá mắt bạn theo dõi không kịp. Chạy xong nhấn F2 xem thấy ghi 50%, 100% đầy đủ.  :)

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

Thật ra nó có làm hết đó chứ, có điều nó làm nhanh quá mắt bạn theo dõi không kịp. Chạy xong nhấn F2 xem thấy ghi 50%, 100% đầy đủ.  :)

Vậy à tại sao máy tôi chỉ có 100% thôi không thấy 50%.

có cách nào cho nó xuất hiện không??

Còn zoom đến từng trắc ngang thì sao bạn?? theo cách lập trình của mình thì nó zoom đến từng trắc ngang rồi nhưng sao không thấy nó zoom??

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

Có 2 đề xuất bạn nên thêm vào ct của bạn:

1. Thêm (setvar 'cmdecho 0) vào đầu ct và (setvar 'cmdecho 1) vào cuối ct để tắt các dòng thông báo linh tinh.

2. Sau lệnh zoom nên đặt thêm (command "delay" 1000) nếu muốn dừng ct 1 giây, hoặc (getstring) nếu muốn dừng bao lâu tùy ý (nhấn phím bất kỳ để tiếp tục). Theo tôi nên dùng getstring (hoặc get.. tùy bạn)  vi no` chắc ăn hơn delay. Tôi đã thử dùng delay nhưng nó chỉ dừng ở vài mc trong số các mc bạn chọn.

  • 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

Có 2 đề xuất bạn nên thêm vào ct của bạn:

1. Thêm (setvar 'cmdecho 0) vào đầu ct và (setvar 'cmdecho 1) vào cuối ct để tắt các dòng thông báo linh tinh.

2. Sau lệnh zoom nên đặt thêm (command "delay" 1000) nếu muốn dừng ct 1 giây, hoặc (getstring) nếu muốn dừng bao lâu tùy ý (nhấn phím bất kỳ để tiếp tục). Theo tôi nên dùng getstring (hoặc get.. tùy bạn)  vi no` chắc ăn hơn delay. Tôi đã thử dùng delay nhưng nó chỉ dừng ở vài mc trong số các mc bạn chọn.

Cám ơn bạn nhưng như vậy phải bấm liên tục à? 1000 trắc ngang thi sao????

Còn vấn đề 1 thì ok sẻ sửa liề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

Tôi thử thì thấy vla có hiệu quả, còn command thì không

 

(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point diemtam) (+ kcach 20)

  • 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

Tôi thử thì thấy vla có hiệu quả, còn command thì không

 

(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point diemtam) (+ kcach 20)

ok. Thế là quá hay rồi

để kiểm tra xem sao

cám ơn bạn nhiều

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ôi thử thì thấy vla có hiệu quả, còn command thì không

 

(vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point diemtam) (+ kcach 20)

Quá tuyệt vời thêm thay dòng lệnh trên nó xuất hiện luôn % đang được xử lý

  • 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

Bạn update lại Lisp nhé. Tks

Lisp đây 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 20))
	;(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) 10))
    (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)
)

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

Thiếu hàm con (thoi) rồi bác ơi.

Bác copy trực tiếp vào trả lời cũng được.

Vậy xóa hàm đó đi không ảnh hưởng gì đâu, do mấy hàm đó nằm trong bộ lisp nên khi chạy mình không phát hiện 

còn hàm đó đây này ai muốn thêm vào thì chép vào. Copy vào trả lời cũng không được là sao nhỉ???

 
(Defun thoi ()
(princ "\nNguyen Huu Nhan Le Thuy - Quang Binh")
(setvar "MODEMACRO" "( ^_^) NGUYEN HUU NHAN - PTVGT II ( ^_^) ")
(Princ)
)  

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

E load về dùng thử thì thấy các khối lượng xuất ra thì lại theo hàng chứ không theo cột.

Nếu bác chỉnh sửa để nó ra đúng theo cột như bảng khối lượng nova nó xuất ra thì sẽ là hoàn hảo. Tiện cho công việc tính toán và sắp sếp in ấn.

Thanks!

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

E load về dùng thử thì thấy các khối lượng xuất ra thì lại theo hàng chứ không theo cột.

Nếu bác chỉnh sửa để nó ra đúng theo cột như bảng khối lượng nova nó xuất ra thì sẽ là hoàn hảo. Tiện cho công việc tính toán và sắp sếp in ấn.

Thanks!

Mục đích xuât qua excel là để xuất khối lượng mà, đây chỉ là bước trung gian thôi, ở excel mình viết 1 modul để sắp xếp lại từng hạng mục giống với nova chứ.

  • 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

Mục đích xuât qua excel là để xuất khối lượng mà, đây chỉ là bước trung gian thôi, ở excel mình viết 1 modul để sắp xếp lại từng hạng mục giống với nova chứ.

 

Em thì không giỏi mây vụ ấy lắm nhưng mà theo em thì nếu để hoàn thiện lisp thì có thể lấy đó là mục đích để mình hướng tới vấn đề cần giải quyết.

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

Hôm trước mình có chạy được lisp rồi nhưng khi xuất ra khối lượng thì nó vẫn xuất ra file *.csv nhưng dung lượng =0, chỉ có mỗi tên file chứ ko có nội dung gì cả

Hôm nay thì khi mình apload lại lisp thì nó lại ko nhận nữa, dù đã remove cái  cũ rồi ap lại vẫn ko nhận: "Unknown command "XKL".  Press F1 for help"

không hiểu đây là lỗi gì nhỉ

tìm được cái li sp hay thế này mà ko dùng được thì phí quá, mong các cao thủ check giùm với, bác chủ thì lâu lắm chưa thấy online 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

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  

×