[Nhờ chỉnh sửa]Lisp tính tổng độ dài đoạn thẳng.

[minhtu2004 36]

-Mình tìm trên diễn đàn có lisp tính độ dài các đoạn thẳng và có chỉnh sửa lại theo nhu cầu công việc. Nhưng có 1 điểm không biết phải làm sao để làm tròn số lên 0.5m.

VD: Tổng độ dài các đoạn thẳng là 19213m mình muốn làm tròn lên 19500m.Còn 19501m thì làm tròn lên 20000m. Tóm lại là làm tròn từ 001--->499 = 500 và từ 501--->999 =1000

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=3778
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq i (getreal "\n Chieu cao ha xuong" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (strcat(rtos tot_len 2 0)"/" (rtos i 2 0)))
;(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)

http://www.cadviet.c...3/35974_cad.dwg

Xin cám ơn mong mọi người giúp đỡ.

[Doan Van Ha 3.192]

-Mình tìm trên diễn đàn có lisp tính độ dài các đoạn thẳng và có chỉnh sửa lại theo nhu cầu công việc. Nhưng có 1 điểm không biết phải làm sao để làm tròn số lên 0.5m.

VD: Tổng độ dài các đoạn thẳng là 19213m mình muốn làm tròn lên 19500m.Còn 19501m thì làm tròn lên 20000m. Tóm lại là làm tròn từ 001--->499 = 500 và từ 501--->999 =1000

http://www.cadviet.c...3/35974_cad.dwg

Xin cám ơn mong mọi người giúp đỡ.

Bạn sử dụng hàm làm tròn số này:

(defun LAM_TRON(so tron)
(if (= (rem so tron) 0)
 so
 (* tron (+ 1 (fix (/ so tron))))))

VD1: (LAM_TRON 20501 500) = 21000

VD2: (LAM_TRON 20471 500) = 20500

[minhtu2004 36]

Bạn sử dụng hàm làm tròn số này:

(defun LAM_TRON(so tron)
(if (= (rem so tron) 0)
 so
 (* tron (+ 1 (fix (/ so tron))))))

VD1: (LAM_TRON 20501 500) = 21000

VD2: (LAM_TRON 20471 500) = 20500

-Cám ơn đã giúp đỡ. Làm phiền bạn hướng dẫn chèn đoạn code đó như thế nào mình chưa hiểu về lisp nhiều lắm.

[Doan Van Ha 3.192]

-Cám ơn đã giúp đỡ. Làm phiền bạn hướng dẫn chèn đoạn code đó như thế nào mình chưa hiểu về lisp nhiều lắm.

1). Copy đoạn code của tôi paste vào đầu hoặc cuối lisp

2). Sửa dòng này: (rtos tot_len 2 2)

Thành: (rtos (LAM_TRON tot_len 500) 2 2)

[minhtu2004 36]

-Thank bạn nhiều. Biết được thêm 1 hàm mới.

[Doan Van Ha 3.192]

-Thank bạn nhiều. Biết được thêm 1 hàm mới.

Chả có hàm nào là mới. Đây là hàm do tôi tự viết chứ không phải hàm của lisp. Muốn dùng được nó thì phải copy và paste vào lisp.

[minhtu2004 36]

Chả có hàm nào là mới. Đây là hàm do tôi tự viết chứ không phải hàm của lisp. Muốn dùng được nó thì phải copy và paste vào lisp.

uh ý mình là cai ham tự tạo này đấy hehe.

[Tue_NV 3.912]

Bạn sử dụng hàm làm tròn số này:

(defun LAM_TRON(so tron)
(if (= (rem so tron) 0)
 so
 (* tron (+ 1 (fix (/ so tron))))))

VD1: (LAM_TRON 20501 500) = 21000

VD2: (LAM_TRON 20471 500) = 20500

Lisp làm tròn ngắn gọn hơn :

(defun Rnd-tron (so tron)
(- so (rem so tron) (- tron))
)

 

VD1: (Rnd-tron 20501 500) -> 21000

VD2: (Rnd-tron 20471 500) -> 20500

[nickao_12 0]

Xin các bác trong diễn đàn chỉnh sửa lisp tính tổng chiều dài để kết quả được ghi bằng Text không? Được như vậy thì tốt quá. Thanks!

[Doan Van Ha 3.192]

Xin các bác trong diễn đàn chỉnh sửa lisp tính tổng chiều dài để kết quả được ghi bằng Text không? Được như vậy thì tốt quá. Thanks!

Lisp đâu bạn?

[Chiron 94]

Xin các bác trong diễn đàn chỉnh sửa lisp tính tổng chiều dài để kết quả được ghi bằng Text không? Được như vậy thì tốt quá. Thanks!

Hi vọng đúng cái bạn cần.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=763
(defun add_mline ()
 (foreach e_record_sub e_record
   (cond ((= 10 (car e_record_sub))
 (setq pt1    (cdr e_record_sub)
mline_len 0.0
 )
)
((= 11 (car e_record_sub))
 (setq pt2    (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1    pt2
 )
)
   )
 )
 (setq tot_len (+ tot_len mline_len))
 (ssdel e_name ss)
)

(defun C:tg (/ tot_len ss e_name e_record e_type txtpnt txtht)
 (setq tot_len 0.0)
 (setq ss (ssget))
 (if (null ss)
   (exit)
 )
 (while (> (sslength ss) 0)
   (setq e_name (ssname ss 0))
   (setq e_record (entget e_name))
   (setq e_type (cdr (assoc '0 e_record)))
   (cond ((wcmatch e_type
  "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE"
 )
 (command "lengthen" e_name "")
 (setq tot_len (+ tot_len (getvar "PERIMETER")))
 (ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
   )
 )
 (setq txtpnt (getpoint "\nSpecify start point of text."))
 (setq txtht
(getdist (strcat "\nSpecify height <"
(rtos (getvar "textsize") 2 2)
">: "
)
)
 )
 (if (null txtht)
   (setq txtht (getvar "textsize"))
 )
 (command "text"
 "m"
 txtpnt
 txtht
 0
 (strcat (rtos (/ tot_len 1000) 2 2) "m")
 )
 (princ)
)

[f4_ars 0]

Các bác cho hỏi là: em tính nhiều lần chiều dài như thế và có yêu cầu là:

1. Ghi đè kết quả lên định dạng text trên bản vẽ

2. Xuất tất cả kết quả của từng lần theo thứ tự ra 1 file txt (hoặc file excell).

Các bác giúp em với. Thanks các bác nhiều.

[dothanhdatvtchd 1]

Em cũng có thắc mắc như bác f4_ars. Điều kiện:

1. Ghi đè kết quả lên text

2. Xuất các giá trị ra file txt

Các bác giúp em với

[Doan Van Ha 3.192]

2 bạn f4_ars và dothanhdavtchf đặt đề lại từ đầu, gồm những công đoạn gì. Bởi hơi khó hiểu khi đề ra nửa chừng. Cái này chắc không khó.

[dothanhdatvtchd 1]

2 bạn f4_ars và dothanhdavtchf đặt đề lại từ đầu, gồm những công đoạn gì. Bởi hơi khó hiểu khi đề ra nửa chừng. Cái này chắc không khó.

Bác giúp em chỉnh lisp theo các bước này với:

1. Chọn các đối tượng cần tính tổng chiều dài (tỉ lệ theo dimstyle hiện hành) _ Lần thứ nhất

2. ghi đè kết quả lên text có sẵn trên bản vẽ

3. Chọn các đối tượng cần tính tổng chiều dài _ Lần 2

4. Ghi đè kq lên text trên bản vẽ

5. Lặp lại bước 1,2

....

Cuối cùng: Nhấn "Space" để kết thúc lệnh. Hỏi có xuất ra file txt không? Nơi lưu file. (Hoặc file excell càng tốt bác ạ)

Tổng 1 =...

Tổng 2=...

.....

Cám ơn bác nhiều. Em mới biết sơ qua lisp nên chưa biết hết các hàm, ko cop được đoạn code. Bác giải thích đoạn code hộ em thì tốt quá ạ :D

[Doan Van Ha 3.192]

Viết nhanh cho bạn đây.

;Doan Van Ha - CADViet.com - Ngay 13/10/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ( / tl lst ss entlst cdai a z)
(vl-load-com)
(setq tl (getreal "\nHe so ti le: "))
(while
 (and
  (princ "\nChon cac doi tuong can tinh chieu dai...")
  (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) tl))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nBan muon luu file khong?[Y/N] <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

P/S: bổ sung 17h-13/10/2012

[dothanhdatvtchd 1]

Viết nhanh cho bạn đây.

;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ()
(vl-load-com)
(setq lst '())
(while (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nGhi ra file <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

Rất cảm ơn bác. Chưa test nhưng em cảm ơn vì muộn rồi mà bác còn nhiệt tình vậy :D Cảm ơn bác

[dothanhdatvtchd 1]

Viết nhanh cho bạn đây.

;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ()
(vl-load-com)
(setq lst '())
(while (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nGhi ra file <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

 

Viết nhanh cho bạn đây.

;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ()
(vl-load-com)
(setq lst '())
(while (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nGhi ra file <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

Bác Ha ạ. Có vài điểm chưa đúng lắm bác ạ:

1. Lisp trên tính chiều dài theo tỉ lệ 1:1

2. Ý em thì các bước là: Tính tổng chiều dài lần 1, sửa vào text 1, tiếp theo tính chiều dài lần 2 luôn, sửa lần 2, rồi tính chiều dài lần 3 luôn, sửa lần 3 luôn... Khi muốn kết thúc thì gõ dấu cách( sau khi sửa text), rồi hỏi: Có lưu không.

Bác giúp em lần nữa với/

Thanks bác

[Doan Van Ha 3.192]

đúng vậy mà, mỗi lần sửa vào 1 text

[dothanhdatvtchd 1]

đúng vậy mà, mỗi lần sửa vào 1 text

Ví dụ cần tính tổng chiều dài 3 lần thì gồm các bước là:

gõ lệnh, "cách", chọn đối tượng lần 1,"cách", Sửa text lần 1, chọn lần 2, "cách", sửa text lần 2, chọn lần 3, "cách", sửa text lần 3,"cách"_kết thúc lệnh_ Hỏi "có lưu file vào đâu ko"

Còn cái tính chiều dài theo tỉ lệ nữa. Bác xem hộ em với. Hì

[Doan Van Ha 3.192]

1). "Cách" sau khi chọn đối tượng mỗi lần xong: đúng. Và lisp đã có.

2). "Cách" sau khi ghi ra text xong: thừa. Nên tôi sẽ không sửa. Bởi, xong bước này thì tự động nhảy qua bước kia thôi.

3). Đã bổ sung tỉ lệ, nhưng sẽ do người dùng nhập vào thay vì lấy theo dimstyle hiện hành, vì 1 bản vẽ có thể có nhiều dimstyle, và đôi khi tỉ lệ theo dimstyle hiện hành chưa phải là tỉ lệ người dùng mong muốn.

4). Tải lại ở link cũ.

[dothanhdatvtchd 1]

"Cách" sau khi chọn đối tượng mỗi lần xong: đúng. Và lisp đã có.

"Cách" sau khi ghi ra text xong: thừa. Và để làm gì nhỉ? Xong bước này thì tự động nhảy qua bước kia, chứ sao phải thêm "cách" vào nữa. Bạn xem có lệnh cad nào hoạt động thừa như vậy không?

Bác xem lại giúp em với. Sau khi sửa text lần 1,2 thì ko có "cách", chỉ có lần 3 là lần cuối cùng để kết thúc thì mới nhấn cách mà bác.

Bác sửa lại 2 vấn đề nữa giúp em với:

1. Tính chiều dài theo tỉ lệ của dim style hiện hành.

2. Sau khi kết thúc lệnh mới xuất kq ra txt hoac excel chứ ko phải sau mỗi lần chọn đối tượng lại hỏi có xuất ko. Làm lệnh thừa và dài.

Cám ơn bác nhé.

[Doan Van Ha 3.192]

Bạn xem lại bài viết tôi mới chỉnh sửa, và down lisp tại link cũ.

[dothanhdatvtchd 1]

Bạn xem lại bài viết tôi mới chỉnh sửa, và down lisp tại link cũ.

Cám ơn bác. Nhưng lệnh bị lỗi rồi thì phải. Em tính tổng chiều dài thì nó toàn ra sai kết quả. Bác xem lại hộ em nhé. Ví dụ đo tổng 2 đoạn dài 50 và 20, tỉ lệ nhập vào là 5 thì kết quả phải là 70/5 =14 đúng ko ạ? Nhưng nó ra là 10,8. :S

Cám ơn bác lần nữa :D

[Doan Van Ha 3.192]

srr, tôi nhầm tí và tôi sửa lại rồi. Link cũ.