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

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

Bởi hhhhgggg , trong AutoLisp

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

hhhhgggg    29

hhhhgggg
Đã đăng

(defun c:tinh()

(vl-load-com)

(if (not ptinh) (setq ptinh "+"))

(if (not ssle) (setq ssle 0))

 

(initget "+ - * / ~")

(setq ptinh1 (getkword (strcat "Chon phep tinh ( + - * / ~ ) <" ptinh "> :"))

ssle1 (getint (strcat "\nSo so le <" (itoa ssle) ">: ")))

(if ptinh1 (setq ptinh ptinh1))

(if ssle1 (setq ssle ssle1))

 

(cond ((= ptinh "+") ;;; cong

(prompt "\nChon text de cong:")

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

kqua 0)

(while (and ss (> (sslength ss) 0))

(setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(princ kqua))

 

((= ptinh "~") ;;; trung binh cong

(prompt "\nChon text de tinh trung binh cong:")

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

sl (sslength ss)

kqua 0)

(while (and ss (> (sslength ss) 0))

(setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(setq kqua (/ kqua sl))

(princ kqua))

 

((= ptinh "*") ;;;nhan

(prompt "\nChon text de nhan:")

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

kqua 1)

(while (and ss (> (sslength ss) 0))

(setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(princ kqua))

 

((= ptinh "-") ;;;tru

(setq sobitru (car (entsel "\nChon so bi tru:"))

sotru (car (entsel "\nChon so tru:\n"))

kqua (- (atof (cdr (assoc 1 (entget sobitru))))

(atof (cdr (assoc 1 (entget sotru))))))

(princ kqua))

 

((= ptinh "/") ;;;chia

(setq sobichia (car (entsel "\nChon so bi chia:"))

sochia (car (entsel "\nChon so chia:\n"))

kqua (/ (atof (cdr (assoc 1 (entget sobichia))))

(atof (cdr (assoc 1 (entget sochia))))))

(princ kqua))

)

 

(setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:"))))

(vla-put-TextString obj (rtos kqua 2 ssle))

(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

gia_bach    1.549

gia_bach
Đã đăng
(defun c:tinh()

(vl-load-com)

(if (not ptinh) (setq ptinh "+"))

(if (not ssle) (setq ssle 0))

 

(initget "+ - * / ~")

(setq ptinh1 (getkword (strcat "Chon phep tinh ( + - * / ~ ) <" ptinh "> :"))

ssle1 (getint (strcat "\nSo so le <" (itoa ssle) ">: ")))

(if ptinh1 (setq ptinh ptinh1))

(if ssle1 (setq ssle ssle1))

 

(cond ((= ptinh "+") ;;; cong

(prompt "\nChon text de cong:")

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

kqua 0)

(while (and ss (> (sslength ss) 0))

(setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(princ kqua))

 

((= ptinh "~") ;;; trung binh cong

(prompt "\nChon text de tinh trung binh cong:")

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

sl (sslength ss)

kqua 0)

(while (and ss (> (sslength ss) 0))

(setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(setq kqua (/ kqua sl))

(princ kqua))

 

((= ptinh "*") ;;;nhan

(prompt "\nChon text de nhan:")

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

kqua 1)

(while (and ss (> (sslength ss) 0))

(setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))

(ssdel ent ss))

(princ kqua))

 

((= ptinh "-") ;;;tru

(setq sobitru (car (entsel "\nChon so bi tru:"))

sotru (car (entsel "\nChon so tru:\n"))

kqua (- (atof (cdr (assoc 1 (entget sobitru))))

(atof (cdr (assoc 1 (entget sotru))))))

(princ kqua))

 

((= ptinh "/") ;;;chia

(setq sobichia (car (entsel "\nChon so bi chia:"))

sochia (car (entsel "\nChon so chia:\n"))

kqua (/ (atof (cdr (assoc 1 (entget sobichia))))

(atof (cdr (assoc 1 (entget sochia))))))

(princ kqua))

)

 

(setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:"))))

(vla-put-TextString obj (rtos kqua 2 ssle))

(princ)

)

Ý bạn là sao ?

Nếu bạn muốn giới thiệu 1 Lisp hay, chỉ cần 1 đuờng Link là đủ.

Hay bạn muốn giới thiệu Lisp của bạn viết ?

 

Bạn có quyền share các List sưu tầm đuợc.

Nhưng dù sao thì bạn cũng cần tôn trọng nguời viết ra nó, chẳng ở đâu xa, ngay trong diễn đàn này.

Lisp bạn cung cấp thực chất đuợc POST trong diễn đàn này, ở topic lisp cộng trừ nhân chia text, giá trị trung bình cộng của các text

do Q288 viết.

Và nếu bạn muốn giới thiệu 1 Lisp hay có cần thiết phải mở 1 TOPIC mới không ?

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

qh2qa06    0

qh2qa06
Đã đăng

Em muốn xin lisp tính giá trị trung bình cộng của các text trong bản vẽ. Định dạng text là Left như trong bản vẽ đính kèm.

http://www.cadviet.com/upfiles/3/64018_tinh_gia_tri_trung_binh_cua_text.dwg

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

nhoclangbat    392

nhoclangbat
Đã đăng

nhoc có 1 lsp mót chỉnh sữa lại 1 tí theo ý bạn, bạn xem sao ^^

;;;Dung de tinh tong cac so
(defun C:tbcc()
  (setq ss (ssget '((0 . "TEXT"))))
  (setq c 0 tong 0)
  (if (/= ss nil)
    (while (< c (sslength ss))
      (setq oldob (entget (ssname ss c)))
      (setq txtstr (assoc 1 oldob))
	  (setq realk (assoc 40 oldob))
	(if (/= txtstr nil)
        (progn
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
          (setq tam (atof num))
          (setq tong (+ tong tam))
		  (setq tbc (/ tong (sslength ss)))
        );progn
      );if
      (setq c (1+ c))
    );while
  );if
  (while (/= tong 0)
    (setq p (getpoint "\nNhap vi tri xuat ket qua: "))
    (command "TEXT" p ctext 0 (rtos tbc 2 3) "")
    (setq tong 0)
  );while
)
(prompt "ten lenh : tbcc")
  • 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

qh2qa06    0

qh2qa06
Đã đăng

 

nhoc có 1 lsp mót chỉnh sữa lại 1 tí theo ý bạn, bạn xem sao ^^

;;;Dung de tinh tong cac so
(defun C:tbcc()
  (setq ss (ssget '((0 . "TEXT"))))
  (setq c 0 tong 0)
  (if (/= ss nil)
    (while (< c (sslength ss))
      (setq oldob (entget (ssname ss c)))
      (setq txtstr (assoc 1 oldob))
	  (setq realk (assoc 40 oldob))
	(if (/= txtstr nil)
        (progn
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
          (setq tam (atof num))
          (setq tong (+ tong tam))
		  (setq tbc (/ tong (sslength ss)))
        );progn
      );if
      (setq c (1+ c))
    );while
  );if
  (while (/= tong 0)
    (setq p (getpoint "\nNhap vi tri xuat ket qua: "))
    (command "TEXT" p ctext 0 (rtos tbc 2 3) "")
    (setq tong 0)
  );while
)
(prompt "ten lenh : tbcc")

Cảm ơn bạn! Lisp của bạn mình dùng tốt rồi. Phản ứng nhanh thật! Không thấy có icon tặng hoa hay vỗ tay gì 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

pphung183    428

pphung183
Đã đăng
nhoclangbat  viết (command "TEXT" p ctext 0 (rtos tbc 2 3) "") thành (command "TEXT" p ctext 0 (rtos tbc 2 3))   để khỏi thấy xuất hiện dòng :

TBCC Unknown command "TBCC".  Press F1 for help.

  • 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

nhoclangbat  viết (command "TEXT" p ctext 0 (rtos tbc 2 3) "") thành (command "TEXT" p ctext 0 (rtos tbc 2 3))   để khỏi thấy xuất hiện dòng :

TBCC Unknown command "TBCC".  Press F1 for help.

Kể cả 2 cách trên cũng đều có thể bị lỗi, tùy thuộc height của style current là bằng 0 hay 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

Nhoc cứ thử với 2 style: 1 style có height = 0 và 1 style có height /= 0. Từ đó dùng (command "text"...) rồi rút ra kết luận. Sau đó dùng hàm if.

Còn dùng vla(x) thì Nhoc chưa biết mà.

  • 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

Tot77    508

Tot77
Đã đăng

Bạn dùng entmake cũng đc.

(entmake (list (cons 0 "TEXT") (cons 1 (rtos tbc 2 3)) (cons 40 ctext) (cons 10 p) (cons 11 p)))

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

nhoclangbat    392

nhoclangbat
Đã đăng

- hi nhoc quên ko để ý nhỉ, a Tue cho nhoc hỏi thêm , có cách lọc ra trong tập mình chọn ko bao gồm các text có dạng SYM không a, trường hợp mình quét chọn mà trong đó có text toàn chữ thì kết quả trả ra sẽ bị sai mấ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

nhoclangbat    392

nhoclangbat
Đã đăng

- nhet cái distof nó vào đâu để kiểm tra anh Ha nhỉ ^^, cái lsp goc của nhoc là tính tổng thui, nếu trong tập chọn có text gồm cả số lẫn chữa thì nó vẫn hiểu chỉ lấy phần số ra tính, còn thêm cái trung bình cộng lại phải dựa trên số lượng của tập chọn ban đầu là bao nhiêu nữa,ý nhoc là khi mình quét mà trong vùng quét  có text toàn chữ ko thì nó loại ra để hàm sslength trả về đúng số lượng

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

hiepttr    538

hiepttr
Đã đăng

tiện đây "xí vô" 1 tí ^^

Nếu dùng read + if + type để xét, thì ngoài cái dài dòng ra còn điều gì đáng lưu ý ko các bá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

nhoclangbat    392

nhoclangbat
Đã đăng

 - nhoc mò có thằng ssdel không biết có đc ko nhỉ, chọn tập lấy mã 1 dùng kỉu gì đó dò qua các đối tượng trong tập, cái nào ko thỏa dùng ssdel loại đi, ra đc số lượng đúng để lấy tbc

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

nhoclangbat    392

nhoclangbat
Đã đăng

- học tới ssget mà quên mất ^^, nhoc mông má lại cái lsp tính trung bình cộng, trong trường hợp bạn đó có trục trặc khi sử dụng lsp cũ sẽ có lsp mới để test lại ^^

;;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)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
  (setq ss (ssget '((0 . "TEXT") (1 . "~*@*"))))
  (setq c 0 tong 0)
  (if (/= ss nil)
    (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))
	(if (/= txtstr nil)
        (progn
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
		  (setq gstyle (cdr mastyle))
		  (setq glayer (cdr malayer))
          (setq tam (atof num))
          (setq tong (+ tong tam))
		  (setq tbc (/ tong (sslength ss)))
        );progn
      );if
      (setq c (1+ c))
    );while
  );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

Tue_NV    3.912

Tue_NV
Đã đăng

 

- học tới ssget mà quên mất ^^, nhoc mông má lại cái lsp tính trung bình cộng, trong trường hợp bạn đó có trục trặc khi sử dụng lsp cũ sẽ có lsp mới để test lại ^^

;;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)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
  (setq ss (ssget '((0 . "TEXT") (1 . "~*@*"))))
  (setq c 0 tong 0)
  (if (/= ss nil)
    (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))
	(if (/= txtstr nil)
        (progn
		  (setq ctext (cdr realk))
          (setq num (cdr txtstr))
		  (setq gstyle (cdr mastyle))
		  (setq glayer (cdr malayer))
          (setq tam (atof num))
          (setq tong (+ tong tam))
		  (setq tbc (/ tong (sslength ss)))
        );progn
      );if
      (setq c (1+ c))
    );while
  );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")

 

Cách tốt nhất là sử dụng hàm distof để lọc số, tránh dùng hàm (setq ss (ssget '((0 . "TEXT") (1 . "~*@*")))) để lọc số, bởi nó không lường hết các trường hợp Text không phải là 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

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
Về Đầu Trang AutoLisp
×