Chuyển đến nội dung
Diễn đàn CADViet
hhhhgggg

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

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

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

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

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

  • 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

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.

  • 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

 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. 

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

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

)

)

  • 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

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

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

@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! 

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

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

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

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

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

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

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

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

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

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

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

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

Đù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ề.....

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

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

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

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

 
  • 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ạ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


×