Lisp tính giá trị trung bình của các Text !!!!

[Tot77 508]

Hàm distof cũng có cái hạn chế, thí dụ (distof "1,234.145")

[Doan Van Ha 3.196]

Hàm distof cũng có cái hạn chế, thí dụ (distof "1,234.145")

Hạn chế gì cơ? 1,234.145 đâu phải là 1 số trong cad?

[nhoclangbat 392]

- hihi nhoc nghe mấy anh dò bằng distof nhưng ko nghĩ ra nỗi đưa nó vào kiểu nào ^^, nhoc thử thay atof = distof quét qua cái nào có text chữ lsp đơ rùi, ko pit lọc kiểu nào để trừ bớt cái thằng sslength, anh nào tốt viết lại lsp cho nhoc học mót với :)

[Doan Van Ha 3.196]

Ví dụ (code nhanh nên chưa kiểm tra kỹ)

(defun C:tbcc()

 (setq ss (ssget '((0 . "TEXT"))))

 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

 (setq lst (mapcar '(lambda(ent) (distof (cdr (assoc 1 (entget ent))))) lst))

 (setq lst (vl-remove-if '(lambda(x) (= x nil)) lst))

 (/ (apply '+ lst) (length lst)))

 

[Tot77 508]

Hạn chế gì cơ? 1,234.145 đâu phải là 1 số trong cad?

 Trong exel thì nó là số, trong cad cũng chẳng quy định cái nào là số hay chữ, vì cad dùng trên toàn thế giới mà. Cũng có nơi họ cho đó là số. Qui định là do con người và hàm distof qui định thôi.

[Doan Van Ha 3.196]

 Trong exel thì nó là số, trong cad cũng chẳng quy định cái nào là số hay chữ, vì cad dùng trên toàn thế giới mà. Cũng có nơi họ cho đó là số. Qui định là do con người và hàm distof qui định thôi.

1). Trong Excel thì nó là số hay không còn tùy thuộc cách format, chứ không hẳn nó luôn là số.

2). Cad có "định nghĩa" thế nào là số hay không thì không biết, nhưng nhập gia thì phải tùy tục. Chúng ta đang "nhập gia" Autodesk thì "tục" của nó là không thể có dấu phẩy (,) và đành chấp nhận vậy. Đây không phải là do hàm distof quy định, mà đây là do Cad quy định. Thử (+ 1,2 1.2) nó cũng thế thôi, đâu cần đến distof. 

[Tue_NV 3.912]

- hihi nhoc nghe mấy anh dò bằng distof nhưng ko nghĩ ra nỗi đưa nó vào kiểu nào ^^, nhoc thử thay atof = distof quét qua cái nào có text chữ lsp đơ rùi, ko pit lọc kiểu nào để trừ bớt cái thằng sslength, anh nào tốt viết lại lsp cho nhoc học mót với :)

 

Nhoc kiểm tra biến num có phải là số không? Nếu num đúng là số thì thực hiện các hàm tính trung bình cộng

 

(if (distof num)

(progn

(setq tam (atof num))

(setq tong (+ tong tam))

(setq tbc (/ tong (sslength ss)))

)

)

[nhoclangbat 392]

- @@ VD của anh Ha dùng distof gọn lẹ quá, nhoc cứ tưởng như Hiệp nói nó phải dài thòng chứ, nhoc chỉ hiểu đc chút xíu lsp a viết ^^, mà công nhận mấy hàm vl kinh thật :)

[Doan Van Ha 3.196]

@Tue_NV: Không thể chia cho (sslength ss) được nếu trong ss có một/vài text không phải là số.

[Tue_NV 3.912]

@Tue_NV: Không thể chia cho (sslength ss) được nếu trong ss có một/vài text không phải là số.

 

Đúng rồi bác! Chắc Nhóc phải tính được cái "length" của mẫu số của số trung bình cộng bằng việc đếm các text số (distof num)

Có tổng, có "length" của mẫu số của số trung bình cộng -> Tính Trung bình cộng 

Chắc Nhóc làm được! 

[nhoclangbat 392]

^^ cách của a Ha nhanh hơn, cách thủ công chắc nhoc phải mò tiếp lang thang đây đó mót xem ^^

[Tue_NV 3.912]

Code cho Nhóc đây!. Nhóc tham khảo nhé! code gọn lẹ ^_^

 

(defun C:tbcc(/ c tong mstbc num ss)
  (setq c -1 tong 0 mstbc 0)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (while (setq ename (ssname ss (setq c (1+ c))))
      (if (setq num (distof (cdr (assoc 1 (entget ename)))))
          (setq tong (+ tong num) mstbc (1+ mstbc))
      );if
    );while
  );if    
(if (null (zerop mstbc)) (/ tong mstbc))
)

[nhoclangbat 392]

- hihi nhoc cũng mới mò ra, code của anh Tue gọn ngang a Ha, cách nhoc mò cũng hao hao cách của anh Tue nhưng dài hơn, vì có mấy hàm nhoc chưa học tới ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/13750-lisp-tinh-gia-tri-trung-binh-cua-cac-text/page-2
;;ham tao text
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  (cons 62 mau)
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;;;
(defun C:tbcc(/ c tong oldob oldos txtstr realk mastyle malayer xtext num gstyle glayer tam tong tbc p ss dem)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\n")
(prompt "cho cac text so:")
(setq ss (ssget '((0 . "TEXT"))))
  
  (if (/= ss nil)
  (progn
  (setq c 0 tong 0.0 dem 0)
    (while (< c (sslength ss))
      (setq oldob (entget (ssname ss c)))
      (setq txtstr (assoc 1 oldob))
	  (setq realk (assoc 40 oldob))
	  (setq mastyle (assoc 7 oldob))
	  (setq malayer (assoc 8 oldob))
	
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
		  (setq gstyle (cdr mastyle))
		  (setq glayer (cdr malayer))
          (setq tam (distof num))
		  (if tam
		  (progn
          (setq tong (+ tong tam))
		  (setq dem (1+ dem))
		  ))
		  (setq c (1+ c))
        );while
		(setq tbc (/ tong dem))
      );progn
      
    );if
    (setq p (getpoint "\nNhap vi tri xuat ket qua: "))
	(if (= tbc 0)
    (mktext p ctext (rtos tbc 2 0) "L" glayer gstyle 1)
	(mktext p ctext (rtos tbc 2 3) "L" glayer gstyle 1)
	)
(setvar "cmdecho" 1)
(setvar "osmode" oldos)
(princ)	   
)
(prompt "ten lenh : tbcc")

[Tue_NV 3.912]

Nhóc cần code gọn gọn lại tí ^_^

Trong code của mình, có hàm nào Nhóc chưa học tới à? Hàm nào vậy? Mình nghĩ các hàm mình viết hầu hết Nhóc đã học tới, vì mình viết dựa trên các hàm nhoc đã viết

 

- Biến dem là mẫu số của phân số Trung bình cộng, cần kiểm tra biến dem có khác 0, kẻo không chọn toàn text chữ không thì sẽ báo là : ; error: divide by zero -> Lỗi phép chia không thể chia cho số 0

 

- Nhóc không chọn text nào cả mà command  xuất ra dòng Nhap vi tri xuat ket qua: là không được nhé -> cần sửa lại

[Doan Van Ha 3.196]

Đùa tí: bác Tue_NV kiểm tra biến đếm khác 0 hơi bị điệu nghệ: (null (zero mstbc)), trong khi chỉ cần (> mstbc 0).

[tien2005 242]

code mới cho nhoc tham khảo

(DEFUN C:tbcc(/ SS ss1 pt TT)
  (defun ssnum (ss);return list ent
    (if ss(vl-remove-if-not
		     '(lambda (x) (distof (cdr (assoc 1 (entget x)))))
		     (vl-remove-if'listp(mapcar'cadr(ssnamex ss)))
		   )
      )
    )
  
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (or sole (setq sole 2))
  
  (if(and(setq sole (cond((getint (strcat "\nLay bao nhieu so le <" (rtos sole 2 0) ">: "))) (sole)))
	 (setq ss (ssnum (ssget '((0 . "TEXT") ))))
	 )
    (progn
      (setq #DIMZIN (GETVAR "DIMZIN"))
      (SETVAR "DIMZIN" 0)
      (setq tt (apply '+(mapcar'(lambda (x) (atof (dxf 1 x)))ss)))
      (setq tt (RTOS (/ tt (length ss) 2 sole))
      (if (setq ss1(car(entsel "\nChon TEXT de ghi ket qua hoac enter de chon diem ghi ket qua: ")))
	  (vla-put-textstring (vlax-ename->vla-object ss1) tt)
	  (entmake
	    (list (cons 0 "TEXT")
		  (cons 1 TT)
		  (cons 7 (dxf 7 (car ss)))
		  (cons 8 (dxf 8 (car ss)))
		  ;...
		  (cons 40 (dxf 40 (car ss)))
		  (cons 10 (getpoint "\nChon diem ghi ket qua: "))
	    )
	  )
	  )
      (SETVAR "DIMZIN" #DIMZIN)
      )
    )
  (princ)
)

[tien2005 242]

hic, thẻ code diễn đàn bị lổi?

(car(entsel"\nChon TEXT de ghi ket.. ")) = (car("\nChon TEXT de ghi ket.. "))

 

(car(entsel "\nChon TEXT de ghi ket.. ")) = (car(entsel "\nChon TEXT de ghi ket.. "))

[nhoclangbat 392]

- ^^ thanks a  Tue nhắc nhở khi nào nhoc khá nhoc sẽ kỹ hơn, mà nhoc nghĩ  mình viết càng kỹ là tránh sai sót cho người dùng, nếu người dùng kỹ sẽ ko có lỗi xây ra  :P  ,thật ra nếu theo sườn bài anh Ket dạy và lv hiện tại của nhoc , hàm ssname, sslength, entget, ssget nhoc chưa học tới toàn mót chưa vững lắm  ( tự bào chữa kaka)

- cảm ơn mấy a có  lsp nhỏ nhoc edit  mà đc nhiều a quan tâm chỉ bảo, viết quá trời code lun ^^

- chắc nhoc ko sữa nữa đâu, mò ra đc thằng này thì lại dính thằng khác choáng rùi ^^, mà mấy anh cũng code ra hết trơn rùi ^^

- mót về khi nào khá lôi ra học ^^

[Tue_NV 3.912]

Đùa tí: bác Tue_NV kiểm tra biến đếm khác 0 hơi bị điệu nghệ: (null (zero mstbc)), trong khi chỉ cần (> mstbc 0).

 

Hề hề, mấy cái đó là quick code bác ạ, trong đầu thoáng thấy cái nào là "chụp" luôn cái đó

Cũng giống như bác đã viết (setq lst (vl-remove-if '(lambda(x) (= x nil)) lst)) 

trong khi chỉ cần (setq lst (vl-remove nil lst))

hề hề.....

[nhoclangbat 392]

- kỳ thật, nhoc lại ko chịu đc cảnh đem co bỏ chợ khó chịu ^^, nhoc lại ráng mò cho ra ^^, dựa trên code anh Tue nhoc ráng viết lại hoàn chỉnh ko bị các lỗi như a Tue nêu, tới đây nhoc nhận ra rằng có quá nhiều trường hợp ^^ để xét @@

- lọc ra các text chỉ số đã ổn 

- nếu ko chọn gì enter hoặc chọn toàn text chữ enter sẽ thoát lệnh ko bị lỗi lsp chạy tới dòng chọn điểm đặt nữa hay lỗi ** Error: divide by zero ** => tạm ổn ^^

- tạo text ghi kết quả height text ko bị ảnh hưởng bởi textstyle khác 0 

- mục đích nhoc lấy các mã dxf trong lsp cũ là là để gán vào text ghi kết quả: ko phải set chiều cao text, lấy lun textstyle, layer của tập chọn cho nó gọn nhưng

  nếu các text ko cùng layer or ko cùng height text or ko cùng style nữa thì sao nhỉ, nếu set thêm layer, style của kq tbc riêng thì có thể có người thấy hơi thừa trong bãn vẽ trừ phi người đó mún tạo ra 1 lst các giá trị tbc nằm ở 1 lớp riêng cho việc khác ^^

- lsp nhoc chỉnh lại dựa trên code a Tue nhoc cũng đã thử các trường hợp trên vẫn in ra đc kq, nhưng các thông số trên dựa theo quy luật nào mà thằng kết quả nó lấy của đối tượng nào để add vô ^^, đã thử nếu nhoc chọn từng thằng 1 thì thằng nào nhoc chọn cuối thì nó sẽ theo thằng đó, còn mà quét 1 lúc thì ko pit đc thằng nào là thằng cuối ^^

(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  (cons 62 mau)
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;;;
(defun C:tbcc(/ c tong mstbc num ss pt glayer ctext gstyle kq old)
(setq old (getvar "osmode"))
(setq c -1 tong 0 mstbc 0)
(if (setq ss (ssget '((0 . "TEXT"))))
 (progn
    (while (setq ename (ssname ss (setq c (1+ c))))
      (if (setq num (distof (cdr (assoc 1 (entget ename)))))
	      
          (setq tong (+ tong num) mstbc (1+ mstbc))
      );if
	  (if ename
	  (progn
	  (setq ctext (cdr (assoc 40 (entget ename))))
	  (setq glayer (cdr (assoc 8 (entget ename))))
	  (setq gstyle (cdr (assoc 7 (entget ename))))
	  )
	  )
    );while
	
	(if (null (zerop mstbc))
	(progn
	(setq kq (/ tong mstbc))
	(setvar "osmode" 0)
	(setq pt (getpoint "\nchon diem dat ket qua:"))
    (mktext pt ctext (rtos kq 2 3) "L" glayer gstyle 1)
     );progn
    );if	 
	
  );progn
);if    
(setvar "osmode" old)
(princ)
)

- p/s: nhiều vấn đề thật, mấy a góp ý cho nhoc với lsp này nên lấy thông số của đối tượng chọn add vào kq hay mình tạo 1 thông số riêng cho nó, cái nào tối ưu hơn nhỉ 

[Doan Van Ha 3.196]

P/S: Các thông số của text thì Nhoc nên lấy theo current style.

[pphung183 428]

Bạn Ha có thể thiết lập biến textsize bằng 0 được không nhỉ? :blush:

[Doan Van Ha 3.196]

Bạn Ha có thể thiết lập biến textsize bằng 0 được không nhỉ? :blush:

Srr, height của textstyle thì có thể bằng 0, nhưng textsize thì luôn khác 0.

[pphung183 428]

Mượn hoa kính Phật, nhoclangbat có thể viết theo bạn Ha theo cách lấy Text height :) :

(vl-load-com)
(defun C:tbcc (/ old CRST RSIZE TSIZE STR PRMT ss lst tbc)
(setq old (mapcar 'getvar (list "cmdecho" "osmode")))
(setvar "cmdecho" 0) (setvar "osmode" 0)
(SETQ CRST (GETVAR "TEXTSTYLE"))
(SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))
(SETQ TSIZE (GETVAR "TEXTSIZE"))
(SETQ STR (RTOS TSIZE 2))
(SETQ PRMT (STRCAT "\nText height <" STR ">:"))
(IF (= RSIZE 0)
  (PROGN
    (INITGET 6)
    (SETQ TSIZE (GETREAL PRMT))
    (IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))
              (SETVAR "TEXTSIZE" TSIZE))
  )
)
 (setq ss (ssget '((0 . "TEXT"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq lst (mapcar '(lambda(ent) (distof (cdr (assoc 1 (entget ent))))) lst))
 (setq lst (vl-remove-if '(lambda(x) (= x nil)) lst))
 (setq tbc (/ (apply '+ lst) (length lst)))
    (setq p (getpoint "\nNhap vi tri xuat ket qua: "))
(IF (= RSIZE 0) (command "TEXT" p TSIZE 0 (rtos tbc 2 3)) (command "TEXT" p 0 (rtos tbc 2 3)))
(mapcar 'setvar (list "cmdecho" "osmode") old)
(princ))

 

[Doan Van Ha 3.196]

Viết như thế sẽ bị lỗi ở dòng (command "text" p tsize...) khi gặp style current có height khác 0.