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

[huunhantvxdts 195]

Đâ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

[Tot77 508]

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 đủ.  :)

[huunhantvxdts 195]

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

[Tot77 508]

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.

[huunhantvxdts 195]

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

[Tot77 508]

Bạn có thể tự chế hàm delay bằng cách repeat nhiều lần setq nào đó, mục đích là làm chậm ct lại.

[ndtnv 481]

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)

[huunhantvxdts 195]

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

[huunhantvxdts 195]

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ý

[tonglao09 2]

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ý

Up lại lisp lên cho mình xin với bạn. ^^

[taybacincc 5]

Bác Huunhantvxdts có thể cho e xin lisp này được không. Ae sử dụng nova mà có cái này thi đỡ bao nhiêu.

Thanks bác trước

[huunhantvxdts 195]

Bác Huunhantvxdts có thể cho e xin lisp này được không. Ae sử dụng nova mà có cái này thi đỡ bao nhiêu.

Thanks bác trước

Mình đã update ở bài #1

[hainguyen2014 12]

Mình đã update ở bài #1

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

[huunhantvxdts 195]

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

[huunhantvxdts 195]

Diễn đàn đang bi lỗi bạn kich vào trả lời để copy lisp nhé

[taybacincc 5]

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.

[huunhantvxdts 195]

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)

)  

[thai11000 4]

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!

[huunhantvxdts 195]

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

[hoquangvinh 7]

bạn up lại lisp #1 đi, bị lỗi rồi thì phải

down về chỉ có mỗi dòng tên lệnh thôi

[huunhantvxdts 195]

bạn up lại lisp #1 đi, bị lỗi rồi thì phải

down về chỉ có mỗi dòng tên lệnh thôi

Bạn kích vào trả lời rồi copy về save lại file lisp

[hoquangvinh 7]

thanks bạn nhé

[huunhantvxdts 195]

Đây là kết quả cần có:

https://youtu.be/eI054HozhwQ

[thai11000 4]

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.

[hoquangvinh 7]

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