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

[Yêu cầu] viết lisp tính chiều dài trung bình của nhiều đoạn thẳng

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

Em có việc này nhờ các cao thủ chút xíu:

- Em biết có lisp tính tổng chiều dài của n đoạn thẳng.

- Vấn đề là em muốn tính chiều dài trung bình của n thằng đó (ví dụ khi muốn có chiều dài trung bình các thanh thép rải trên tường cánh cửa cống hình thang chẳng hạn). Có lẽ chỉ cần viết thêm một đoạn code để chia cái thằng tổng đó cho n thôi. Nhờ các cao thủ giúp cho.

Em cám ơn trướ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

Em có việc này nhờ các cao thủ chút xíu:

- Em biết có lisp tính tổng chiều dài của n đoạn thẳng.

- Vấn đề là em muốn tính chiều dài trung bình của n thằng đó (ví dụ khi muốn có chiều dài trung bình các thanh thép rải trên tường cánh cửa cống hình thang chẳng hạn). Có lẽ chỉ cần viết thêm một đoạn code để chia cái thằng tổng đó cho n thôi. Nhờ các cao thủ giúp cho.

Em cám ơn trước nhé!

Bạn phải đưa lisp của bạn lên thì ng khác mới thêm vào dc chứ.

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 dùng tạm cái này, lệnh tb :

 

(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:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (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 tot_len (* k tot_len))
(setq tbinh (/ tot_len len))
 (alert (rtos tbinh 2 2))
)

  • 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 dùng tạm cái này, lệnh tb :

 

(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:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (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 tot_len (* k tot_len))
(setq tbinh (/ tot_len len))
 (alert (rtos tbinh 2 2))
)

 

XIN ĐA TẠ CAO THỦ NHÉ! ĐÚNG Ý EM RỒI ĐẤ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

bạn ơi muốn chuyển nó thành đơn vị m...thì sửa list thế nào :rolleyes:

 

ý mình lúc nó hiện lên thông báo kiểu đại loại là :[ tong trung binh cac doan vua chon la 5.0m] kiểu thế :wacko:

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 ơi muốn chuyển nó thành đơn vị m...thì sửa list thế nào :rolleyes:

 

ý mình lúc nó hiện lên thông báo kiểu đại loại là :[ tong trung binh cac doan vua chon la 5.0m] kiểu thế :wacko:

Kiểu đại loại thế này :

(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:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (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 tot_len (* k tot_len))
(setq tbinh (/ tot_len len 1000))
 (alert (strcat "Chieu dai trung binh cac doan vua chon là : "(rtos tbinh 2 2)))
) 

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

Kiểu đại loại thế này :

(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:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (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 tot_len (* k tot_len))
(setq tbinh (/ tot_len len 1000))
 (alert (strcat "Chieu dai trung binh cac doan vua chon là : "(rtos tbinh 2 2)))
) 

 

bạn ơi muốn thêm đuôi [Chieu dai trung binh cac doan vua chon la : .... "m"]

mà sao mình load list vào đánh lệnh tb thì nó toàn lên cái bảng Insert Table là sao :unsure:

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

Trường hợp đó chỉ xảy ra khi bạn chưa thực sự load cái lisp có lệnh TB

không phải bạn ạ....mình có load/unload applications/ -> Contens....

 

có add vào mà....

 

mà mình có remove list đi thì đánh lệnh tb nó vẫn hiện ra cái bảng đó...chả biết bị gì :unsure:

 

(trước thì không có giờ tự nhiên bị)

 

mà xem trong acad.pgp cũng có lệnh này

 

TB, *TABLE

 

giờ lại được....??? chả hiểu bị gì :wacko:

  • Vote giảm 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

không phải bạn ạ....mình có load/unload applications/ -> Contens....

 

có add vào mà....

 

mà mình có remove list đi thì đánh lệnh tb nó vẫn hiện ra cái bảng đó...chả biết bị gì :unsure:

 

(trước thì không có giờ tự nhiên bị)

tb là lệnh tắt mặc định CAD đặt cho Insert Table. Nếu load thành công lisp thì lệnh TB sẽ đổi thành function TB lisp quy định, chứ không còn là Insert Table mặc định của CAD nữa. Vì thế đoạn này bạn nói là hơi bị lủng củng :lol:

mà mình có remove list đi thì đánh lệnh tb nó vẫn hiện ra cái bảng đó...chả biết bị gì :unsure:

(trước thì không có giờ tự nhiên bị)

 

Lưu ý với bạn, 1 lisp add vào contents thì chỉ có tác dụng từ phiên làm việc kế tiếp. Muốn tác dụng với phiên làm việc hiện tại thì phải LOAD

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

tb là lệnh tắt mặc định CAD đặt cho Insert Table. Nếu load thành công lisp thì lệnh TB sẽ đổi thành function TB lisp quy định, chứ không còn là Insert Table mặc định của CAD nữa. Vì thế đoạn này bạn nói là hơi bị lủng củng :lol:

 

 

Lưu ý với bạn, 1 lisp add vào contents thì chỉ có tác dụng từ phiên làm việc kế tiếp. Muốn tác dụng với phiên làm việc hiện tại thì phải LOAD

 

mình dùng cad 2010 nhé bạn :rolleyes: ....mà vấn đề đã được giải quyết roài :wacko: đổi lệnh là xong :D

 

dù sao cũng thank bạn :D

  • Vote giảm 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ác Ketxu có thể phát triển thành tính trung bình các đoạn thẳng và cho ghi ra text mới hoặc chép đè lên text đã có sẵn giúp anh em tí được không.Thanks

PS: Nếu thêm được đổi mầu kết quả nữa thì tuyệ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

tks bác Ngọc sơn!!

Sau khi sử dụng lisp trên đang xảy ra lỗi này:

-Nếu chọn C(có) thì ghi ra text có sẵn nhưng vẫn xuất hiện Aler báo kết quả(không cần thiết khi đã chọn ghi text)

-Nếu chọn K(không) thì kết quả không được ghi ra

Mong bác check lại và sửa hộ em

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 kiểm tra lại với lisp này nhé !

Mình check ok mà

(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:tb (/ tot_len ss e_name e_record e_type)
(grtext -1 "Free from cadviet.com @ketxu")
(setq k (getvar "dimlfac"))
 (setq tot_len 0.0)
 (setq ss (ssget))
 (setq len (sslength ss))
 (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 tot_len (* k tot_len))
(setq tbinh (/ tot_len len))
;--------------------------------------------
(setq Kieu (strcase (getstring "\nGhi ra Text co san <Co>/Khong: ")))
(Cond
((/= Kieu "K")
 (setq elst (entget (car (entsel "\n Thay cho so: "))))
 (setq elst (subst (cons 1 (rtos tbinh 2 2)) (assoc 1 elst) elst))
;; doan ma lisp chuyen mau ket qua tinh
(if (assoc 62 elst)
(setq elst (subst (cons 62 80) (assoc 62 elst) elst))
(setq elst (append elst (list (cons 62 80))))
)
(entmod elst)
(princ)
)
((= Kieu "K")
;--------------------------------------------
(setq point (getpoint "\n Chon diem ghi ket qua: "))
(setq th (getvar "textsize"))
(setq th (getstring (strcat "\nChieu cao chu <"(rtos th)"> :")))
(command "TEXT" point th 0 (rtos tbinh 2 2))
(alert (strcat "Chieu dai trung binh cac doan vua chon: "(rtos tbinh 2 2)))
;---------------------------------------------
)
)
(princ)
)

Lệnh: tb nếu chọn ghi ra text có sẵn: bỏ qua là có, nếu không ghi K

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

Chọn C(có) đã ok

Chọn K(không) chỉ xuất hiện Alert mà không thể hiện được kết quả ra text anh à.

 

Đồng thời nhờ anh thêm đoạn đổi mầu vào Lisp tính chiều dài sau của em với.Tks

 

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
 (setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq tong (+ tong (getvar "perimeter")))

(setq index (1+ index))
)
(print tong)
(prompt "Ghi text moi <G> hay thay the text (T) :")
(setq luachon (getstring))
(setq luachon (strcase luachon))
(if (= "" luachon) (setq luachon "G"))
(if (= "G" luachon)
(progn
  (setq pt1 (getpoint))
  (setq h (/ (getvar "viewsize") 20))
  (command "text" pt1 h "" tong)
 )
)
(if (= "T" luachon)
(progn
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
 (setq s (entget (SSNAME TT 0)))
 (setq otext (assoc 1 s))
 (setq ot (cdr otext))
 (setq ot (read (substr ot 1 )))
 (setq nt (cons 1 (rtos tong 2)))
 (setq s (subst nt otext s))
 (entmod s)
)
)
)

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ái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)

bạn thử xem

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
 (setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq tong (+ tong (getvar "perimeter")))

(setq index (1+ index))
)
(print tong)
(prompt "Ghi text moi <G> hay thay the text (T) :")
(setq luachon (getstring))
(setq luachon (strcase luachon))
(if (= "" luachon) (setq luachon "G"))
(if (= "G" luachon)
(progn
  (setq pt1 (getpoint))
  (setq h (/ (getvar "viewsize") 20))
  (command "text" pt1 h "" tong)
 )
)
(if (= "T" luachon)
(progn
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
 (setq s (entget (SSNAME TT 0)))
 (setq otext (assoc 1 s))
 (setq ot (cdr otext))
 (setq ot (read (substr ot 1 )))
 (setq nt (cons 1 (rtos tong 2)))
 ;(setq s (subst nt otext s))
(setq s (subst (cons 62 80) (assoc 62 s) s))
(setq s (append s (list (cons 62 80))))
(entmod s)
(princ)
)
)
)

Tôi chỉ sửa qua được vậy thôi :D

Cái số 80 là mầu, bạn thích mầu nào thay số 80=màu (1...256)

  • 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

SR mọi người.Hôm nay e kiểm tra lại thì lisp đã đổi màu nhưng lại không ghi đúng kết quả.Bác nào có thể giúp em kiểm tra được không ạ!mong!!!

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ái chọn K máy bạn không được, mình không rõ lắm vì máy mình ok (Bạn thử kiểm tra lại chế độ bắt điểm)

bạn thử xem

(prompt "command : dai")
(defun c:dai()
(setq tong 0)
(setq th (ssget))
(setq index 0)
(setq dtuong (sslength th))
(while (< index dtuong)
 (setq ds (entget (ssname th index)))

(command "lengthen" (ssname th index) "" )
(setq tong (+ tong (getvar "perimeter")))

(setq index (1+ index))
)
(print tong)
(prompt "Ghi text moi <G> hay thay the text (T) :")
(setq luachon (getstring))
(setq luachon (strcase luachon))
(if (= "" luachon) (setq luachon "G"))
(if (= "G" luachon)
(progn
  (setq pt1 (getpoint))
  (setq h (/ (getvar "viewsize") 20))
  (command "text" pt1 h "" tong)
 )
)
(if (= "T" luachon)
(progn
(prompt "\n Chon gia tri can thay the")
(SETQ TT (SSGET))
 (setq s (entget (SSNAME TT 0)))
 (setq otext (assoc 1 s))
 (setq ot (cdr otext))
 (setq ot (read (substr ot 1 )))
 (setq nt (cons 1 (rtos tong 2)))
 ;(setq s (subst nt otext s))
(setq s (subst (cons 62 80) (assoc 62 s) s))
(setq s (append s (list (cons 62 80))))
(entmod s)
(princ)
)
)
)

Tôi chỉ sửa qua được vậy thôi :D

Cái số 80 là mầu, bạn thích mầu nào thay số 80=màu (1...256)

Hề hề hề,

Bác NguyenNgocSon xem lại dòng code này:

(command "text" pt1 h "" tong)

Hình như chỗ "" phải là một giá trị số mới đúng bác ạ.

  • 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

SR mọi người.Hôm nay e kiểm tra lại thì lisp đã đổi màu nhưng lại không ghi đúng kết quả.Bác nào có thể giúp em kiểm tra được không ạ!mong!!!

Hề hề hề,

Bạn có thể nói rõ cái sự không đúng ấy nó ra răng không??? Luôn không đúng hay có trường hợp đúng có trường hợp sai??? Hay nó luôn ghi một giá trị nào đó???

Hề hề hề,...

  • Vote tăng 2

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ám ơn bác. Có lẽ như này chăng ?

(command "text" pt1 h 0 tong)

Quả thực lỗi như bạn w1nDream nói mình test máy mình không sao cả ?

Lỗi xảy ra khi chiều cao của Text Style hiện hành khác 0 (khi ghi text mới)

Cái này thường hay bị khi sử dụng Command

Cách khắc phục : Set chiều cao của Text Style hiện hành =0 (hoặc viết text mới bằng hàm entmake)

  • 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

Tks các anh!^^

@phamthanhbinh: Hj.Sai là nó không thể ghi ra kết quả theo đúng chiều dài đo được(mà chỉ đổi mầu đối tượng)

 

@Tue_NV: Em đã thử lại với 1 bản vẽ mới hoàn toàn.Chỉ có style standard. chiều cao chữ trong style = 0, nhưng vẫn không ghi được kết quả

 

@nguyenngocson: Em cũng không hiểu.Anh thử kiểm tra hộ em với.

Với TH C(có) thì kết quả vẫn không ghi ra đượ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

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  

×