LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô

Tháng 4 14, 2009

Kính gửi các Pro

Tôi đã tìm kiếm trên diễn đàn rùi nhưng không có. Xin đừng ném đá tui nhé.

Tôi có 1 bản đồ với các điểm caođộ ở dạng TEXT, giờ muốn cộng toàn bộ chúng hoặc các đối tượng được chọn) thêm 1 hằng số K nào đó và ghi đè lên giá trị cũ ởđúng vị trí cũ thì làm thế nào? Kính mong các cao thủ giúp đỡ. Chân thành cảm ơn

Tháng 4 14, 2009

Kính gửi các Pro
Tôi đã tìm kiếm trên diễn đàn rùi nhưng không có. Xin đừng ném đá tui nhé.

Tôi có 1 bản đồ với các điểm caođộ ở dạng TEXT, giờ muốn cộng toàn bộ chúng hoặc các đối tượng được chọn) thêm 1 hằng số K nào đó và ghi đè lên giá trị cũ ởđúng vị trí cũ thì làm thế nào? Kính mong các cao thủ giúp đỡ. Chân thành cảm ơn

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong : ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (
(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

Tháng 7 12, 2009

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong <" (rtos newo) ">: ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (< i n)

(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

rất hay

Tháng 7 12, 2009

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong <" (rtos newo) ">: ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (< i n)

(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

Tui là gà mới vào nghề nên chẳng hiểu gì cả, bác Pro nào có thể giải thích rõ hơn để anh em gà còn có cơ hội thành gà già. Thank u! :s_big:

Tháng 7 12, 2009

Kính gửi các Pro
Tôi đã tìm kiếm trên diễn đàn rùi nhưng không có. Xin đừng ném đá tui nhé.

Tôi có 1 bản đồ với các điểm caođộ ở dạng TEXT, giờ muốn cộng toàn bộ chúng hoặc các đối tượng được chọn) thêm 1 hằng số K nào đó và ghi đè lên giá trị cũ ởđúng vị trí cũ thì làm thế nào? Kính mong các cao thủ giúp đỡ. Chân thành cảm ơn

Cái này cũng tương tự

(defun c:as()

(setq i 0 s1 0)
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
 (prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
	(repeat (sslength txt)
	(setq txt_name (ssname txt i))
	  (setq txt_ent (entget txt_name))
	(setq cont (cdr(assoc 1 txt_ent)))
	(setq cont (atof cont))
	(setq s (+ cont n))	  
  (setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
	(entmod txt_ent)
	(setq i (+ i 1))
);repeat
);defun	
;------------------------------------------------------

Tháng 10 26, 2009

sao ko có LISP nào mình dùng được hết vậy bạn?

Tháng 10 26, 2009

sao ko có LISP nào mình dùng được hết vậy bạn?

Bạn nhấn nút Reply bài viết -> chép hết code (không sót nhé) về chạy là được

Tháng 10 28, 2010

Kính gửi các Pro
Tôi đã tìm kiếm trên diễn đàn rùi nhưng không có. Xin đừng ném đá tui nhé.

Tôi có 1 bản đồ với các điểm caođộ ở dạng TEXT, giờ muốn cộng toàn bộ chúng hoặc các đối tượng được chọn) thêm 1 hằng số K nào đó và ghi đè lên giá trị cũ ởđúng vị trí cũ thì làm thế nào? Kính mong các cao thủ giúp đỡ. Chân thành cảm ơn

Tháng 8 1, 2011

Đây bạn :

(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong <" (rtos newo) ">: ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (< i n)

(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

Các bác cho em hỏi, có thể sửa lisp này cho đối tượng chọn là mtext được không? vì đối tượng text nằm ở gữa khung, khi dùng lisp này thì đối tượng text không còn mằm ở giữa khung nữa. mong các bác chỉ giúp.

Tháng 8 1, 2011

Các bác cho em hỏi, có thể sửa lisp này cho đối tượng chọn là mtext được không? vì đối tượng text nằm ở gữa khung, khi dùng lisp này thì đối tượng text không còn mằm ở giữa khung nữa. mong các bác chỉ giúp.

Hề hề hề,

Bạn nói chi thế nhỉ??? Lisp này chỉ đổi nội dung text chứ có đả động chi tới các thông số khác của text đâu mà bảo nó chạy mới nhày được????

Hãy gửi cái bản vẽ gốc của bạn và cái kết quả có sau khi xài cái lisp này lên để mọi người kiểm tra giùm. Hay là bạn lại đẻ thêm cái chức năng chi chi đó cho lisp này vậy???

Hề hề hề.

Tháng 4 21, 2012

thanks các bác

Tháng 4 21, 2012

Cái này cũng tương tự

(defun c:as()

(setq i 0 s1 0)
(setq n (getreal "\nnhap so bi tru hoac so de cong: "))
 (prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
(repeat (sslength txt)
	(setq txt_name (ssname txt i))
  	(setq txt_ent (entget txt_name))
	(setq cont (cdr(assoc 1 txt_ent)))
	(setq cont (atof cont))
	(setq s (+ cont n))     
 	(setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
	(entmod txt_ent)
	(setq i (+ i 1))
);repeat
);defun   
;------------------------------------------------------

Lisp rất hay bạn có thể bổ sung thêm phép trừ

cám ơn nhiều lắm

Tháng 4 21, 2012

Bạn hãy search trên diễn đàn với từ khóa defun c:tinh lisp , ngoài ra bản thân phép trừ cũng chính là phép cộng số âm, có phải bạn đang quá bị động k ?

Tháng 4 22, 2012

Bạn hãy search trên diễn đàn với từ khóa defun c:tinh lisp , ngoài ra bản thân phép trừ cũng chính là phép cộng số âm, có phải bạn đang quá bị động k ?

mình đã load lisp tính rồi nhưng lisp đó chỉ tính những số mình chọn ví dụ như cộng các số lại với nhau hay lấy số này trừ số kia chứ không lấy những số mình chọn rồi thực hiện cộng trừ nhân chia với 1 giá trị cụ thể. Ừ nhỉ sao mình không nghĩ ra nhiều khi đơn giãn lại muốn làm cho phức tạp lên để lại đau đầu suy nghĩ.

Tháng 4 23, 2012

Thêm 1 chú nữa:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567
;;----------------------------------------------;;
;; Text calculation tool -  Skywings ;;
;;----------------------------------------------;;
;;***SUB-FUNCTION***
(defun GET-TEXT ()
 (princ "\nSelect NUMBERs : ")
 (while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\n**NOTHING selected!**")
 )
)
(defun GET-DATA (/ ss-mt ss-t n)
 (setq ss-mt (ssadd)
ss-t  (ssadd)
n 	0
sw	0
 )
 (repeat (sslength Numbers)
(setq ent (ssname Numbers n))
(if (= (cdr (assoc 0 (entget ent))) "MTEXT")
 	(setq ss-mt (ssadd ent ss-mt))
 	(setq ss-t (ssadd ent ss-t))
)
(setq n (1+ n))
 ) 
 (if (/= (sslength ss-mt) 0)
(setq Numbers (acet-explode ss-mt)
  sw   1
)
 )
 (setq n 0)
 (repeat (sslength ss-t)
(setq ent   (ssname ss-t n)
  Numbers (ssadd ent Numbers)
  n   (1+ n)
)
 )
)
(defun GET-VALUE (name / sw)
 (princ (strcat "\nSelect " name " : "))
 (cond
((= (cdr (assoc 0 (entget ename))) "MTEXT")
	(command ".explode" ename "")
	(setq value (read (cdr (assoc 1 (entget (entlast)))))
sw  1
	)
)
((setq value (read (cdr (assoc 1 (entget ent))))))
 )
 (if (= sw 1)
(command ".undo" 1)
 )
 value
)
(defun OPT ()
 (if (null option)
(setq option "Replace"
  save2  option
)
 )
 (initget "Replace Create Do-nothing")
 (setq
option
	(getkword
  	(strcat "\nOptions: [Replace/Create/Do-nothing] <"
   	option
   	"> "
  	)
	)
 )
 (if (null option)
(setq option save2)
(setq save2 option)
 )
 (setq switch 1)
)
(defun ACTION (option result / txt pnt)
 (cond
((= option "Replace")
	(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
  	(princ "\n**NOTHING selected!**")
	)
	(setq txt (entget (car txt))
txt (subst (cons 1 result) (assoc 1 txt) txt)
	)
	(entmod txt)
)
((= option "Create")
	(setq pnt (getpoint "\nSpecify start point of text:"))
	(entmake (list (assoc 0 ent)
 	(assoc 8 ent)
 	(cons 1 result)
 	(cons 10 (trans pnt 1 0))
 	(assoc 40 ent)
 	(assoc 7 ent)
 	(assoc 50 ent)
  	)
	)
)
 )
)
(defun GET-ORDER ()
 (princ (strcat "\nCurrent setting: Precision = "
  (rtos precision 2 0)
  " <"
  (rtos 0 2 precision)
  ">"
 )
 )
 (initget
"Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision"
 )
 (setq operation
 (getkword
(strcat
 	"\nOperations: [Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]: <"
 	operation
 	"> "
)
 )
 )
 (if (null operation)
(setq operation save1)
(setq save1 operation)
 )
)
;;***MAIN FUNCTION***:
(defun c:TCAL (/ Numbers   DIVIDEND  DIVISOR   ENT  ID
  INDEX	MINUEND   NUM-MAX   NUM-MIN  NUM-SET
  RESULT	SUBTRAHEND    	SWITCH  VALUE
  sw
 )
 (princ
"** Text calculation tool - Skywings **"
 )
 (setvar "CMDECHO" 0)
 (setvar "QAFLAGS" 1)
 (if (null precision)
(setq precision 2
  save3 precision
)
 )
 (if (null operation)
(setq operation "Plus"
  save1 operation
)
 )
 (GET-ORDER)
 (while (= operation "preCision")
(initget 4)
(setq
 	precision (getint (strcat "\nSpecify new precision: <"
(rtos precision 2 0)
"> "
  )
 )
)
(if (null precision)
 	(setq precision save3)
 	(setq save3 precision)
)
(GET-ORDER)
 )
 (cond
;; PLUS:
((= operation "Plus")
	(GET-TEXT)
	(setq switch 0)
	(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	result 0
  	)
  	(princ "\n>>Expression: ")
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(progn
 	(setq result (+ result value))
 	(if (/= index 1)
   	(princ " + ")
 	)
 	(princ (rtos value 2 precision))
)
 )
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option (rtos result 2 precision))
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
	)
)
;; MULTIPLY:
((= operation "Multiply")
 	(GET-TEXT)
 	(setq switch 0)
 	(while (/= Numbers nil)
(GET-DATA)
(setq index 0
  	result 1
)
(princ "\n>>Expression: ")
(repeat (sslength Numbers)
  (setq ent   (entget (ssname Numbers index))
 value (read (cdr (assoc 1 ent)))
 index (1+ index)
  )
  (if (numberp value)
	(progn
  	(setq result (* result value))
  	(if (/= index 1)
 (princ " * ")
  	)
  	(princ (rtos value 2 precision))
	)
  )
)
(if (= sw 1)
  (command ".undo" 1)
)
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq Numbers nil
  	Numbers (ssget '((0 . "*TEXT")))
)
 	)
)
;; SUBTRACT:
((= operation "Subtract")
 	(setq switch 0
	sw 0
 	)
 	(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
 	(setq minuend (GET-VALUE "MINUEND"))
 	(while (null (numberp minuend))
(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
(setq minuend (GET-VALUE "MINUEND"))
 	)
 	(princ minuend)
 	(redraw ename 3)
 	(princ "\nSelect SUBTRAHENDs : ")
 	(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect SUBTRAHENDs : ")
 	)
 	(redraw ename 4)
 	(while (/= ename nil)
(GET-DATA)
(setq index   0
  	result  0
  	minuend (float minuend)
)
(princ (strcat "\n>>Expression: "
    	(rtos minuend 2 precision)
    	" - ("
   	)
)
(repeat (sslength Numbers)
  (setq ent	(entget (ssname Numbers index))
 subtrahend (read (cdr (assoc 1 ent)))
 index	(1+ index)
  )
  (if (numberp subtrahend)
	(progn
  	(setq result (+ result subtrahend))
  	(if (/= index 1)
 (princ " + ")
  	)
  	(princ (rtos subtrahend 2 precision))
	)
  )
)
(princ ")")
(if (= sw 1)
  (command ".undo" 1)
)
(setq result (- minuend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
  	ename (car (entsel (strcat "\nSelect MINUEND : ")))
)
(if
  (or
	(null ename)
	(null (numberp (setq minuend (GET-VALUE "MINUEND"))))
  )
  (progn
	(setvar "QAFLAGS" 0)
	(vl-exit-with-error "")
  )
)
(princ minuend)
(princ "\nSelect SUBTRAHENDs <TEXT>: ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
  (princ "\nSelect SUBTRAHENDs : ")
)
 	)
)
;; DIVIDE:
((= operation "Divide")
 	(setq switch 0
	sw 0
 	)
 	(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
 	(setq dividend (GET-VALUE "DIVIDEND"))
 	(while (null (numberp dividend))
(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
(setq dividend (GET-VALUE "DIVIDEND"))
 	)
 	(princ dividend)
 	(redraw ename 3)
 	(princ "\nSelect DIVISORs : ")
 	(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect DIVISORs : ")
 	)
 	(redraw ename 4)
 	(while (/= ename nil)
(GET-DATA)
(setq index   0
  	result  1
  	dividend (float dividend)
)
(princ (strcat "\n>>Expression: "
    	(rtos dividend 2 precision)
    	" / ("
   	)
)
(repeat (sslength Numbers)
  (setq ent (entget (ssname Numbers index))
 divisor (read (cdr (assoc 1 ent)))
 index (1+ index)
  )
  (if (numberp divisor)
	(progn
  	(setq result (* result divisor))
  	(if (/= index 1)
 (princ " * ")
  	)
  	(princ (rtos divisor 2 precision))
	)
  )
)
(princ ")")
(if (= sw 1)
  (command ".undo" 1)
)
(setq result (/ dividend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
  	ename (car (entsel (strcat "\nSelect DIVIDEND : ")))
)
(if
  (or
	(null ename)
	(null (numberp (setq dividend (GET-VALUE "DIVIDEND"))))
  )
  (progn
	(setvar "QAFLAGS" 0)
	(vl-exit-with-error "")
  )
)
(princ dividend)
(princ "\nSelect DIVISORs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
  (princ "\nSelect DIVISORs : ")
)
 	)
)
;; AVERAGE:
((= operation "Average")
	(GET-TEXT)
	(setq switch 0)
	(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	id 0
 	result 0
  	)
  	(princ "\n>>Expression: (")
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(progn
 	(setq result (+ result value)
	id   (1+ id)
 	)
 	(if (/= index 1)
   	(princ " + ")
 	)
 	(princ (rtos value 2 precision))
)
 )
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(setq result (rtos (/ (float result) id) 2 precision))
  	(princ (strcat ") / " (rtos id 2 0)))
  	(princ (strcat "\n>>RESULT = " result))
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option result)
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
	)
)
;; MAX-MIN:
((= operation "maX-min")
	(GET-TEXT)
	(setq switch 0)
	(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	Num-set nil
  	)
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(setq Num-set (cons value Num-set))
 )
  	)
  	(setq Num-set (vl-sort Num-set '>)
 	num-max (car Num-set)
 	num-min (last Num-set)
 	result  (strcat "MAX = "
   	(rtos num-max 2 precision)
   	"  MIN = "
   	(rtos num-min 2 precision)
  	)
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(princ "\n>>Numbers set: ")
  	(princ Num-set)
  	(print)
  	(princ result)
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option result)
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
	)
)
;; ADD-BY...:
((= operation "ADd-by")
	(if (null number0)
  	(setq number0 0.00
 	save4 number0
  	)
	)
	(setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> "))
index   0
	)
	(if (null number0)
  	(setq number0 save4)
  	(setq save4 number0)
	)
	(GET-TEXT)
	(GET-DATA)
	(repeat (sslength Numbers)      
  	(setq ent   (entget (ssname Numbers index))
 	value (read (cdr (assoc 1 ent)))
 	index (1+ index)
  	)      
  	(if (numberp value)
 (setq value (+ (float value) number0)
   	ent   (subst (cons 1 (rtos value 2 precision))
  	(assoc 1 ent)
  	ent
  	)
 )
  	)
  	(entmod ent)      
	)
)
;;MULTIPLY-BY...:
((= operation "mUltiply-by")
	(if (null number0)
  	(setq number0 0.00
 	save4 number0
  	)
	)
	(setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> "))
index   0
	)
	(if (null number0)
  	(setq number0 save4)
  	(setq save4 number0)
	)
	(GET-TEXT)
	(GET-DATA)
	(repeat (sslength Numbers)
  	(setq ent   (entget (ssname Numbers index))
 	value (read (cdr (assoc 1 ent)))
 	index (1+ index)
  	)
  	(if (numberp value)
 (setq value (* (float value) number0)
   	ent   (subst (cons 1 (rtos value 2 precision))
  	(assoc 1 ent)
  	ent
  	)
 )
  	)
  	(entmod ent)
	)
)
 )
 (princ "<Exit>")
 (setvar "QAFLAGS" 0)
 (princ)
)

Tcal dùng lựa chọn AD (add-by) nhập hằng số K là -K nếu muốn trừ, K nếu muốn cộng

Tháng 4 23, 2012

Cái này của Swings, bạn nên dẫn đến topic thì hay hơn :)

Tháng 4 23, 2012

Với vấn đề này các bác có thể tham khảo lệnh tcount trong acad và sử dụng linh hoạt sẽ không nhất thiết cần dùng đến autolisp. Chúc các bạn sử dụng hiệu quả trong acad.

Tháng 5 3, 2012

Thêm 1 chú nữa:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567
;;----------------------------------------------;;
;; Text calculation tool -  Skywings ;;
;;----------------------------------------------;;
;;***SUB-FUNCTION***
(defun GET-TEXT ()
 (princ "\nSelect NUMBERs : ")
 (while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\n**NOTHING selected!**")
 )
)
(defun GET-DATA (/ ss-mt ss-t n)
 (setq ss-mt (ssadd)
ss-t  (ssadd)
n 	0
sw	0
 )
 (repeat (sslength Numbers)
(setq ent (ssname Numbers n))
(if (= (cdr (assoc 0 (entget ent))) "MTEXT")
 	(setq ss-mt (ssadd ent ss-mt))
 	(setq ss-t (ssadd ent ss-t))
)
(setq n (1+ n))
 )
 (if (/= (sslength ss-mt) 0)
(setq Numbers (acet-explode ss-mt)
  sw   1
)
 )
 (setq n 0)
 (repeat (sslength ss-t)
(setq ent   (ssname ss-t n)
  Numbers (ssadd ent Numbers)
  n   (1+ n)
)
 )
)
(defun GET-VALUE (name / sw)
 (princ (strcat "\nSelect " name " : "))
 (cond
((= (cdr (assoc 0 (entget ename))) "MTEXT")
(command ".explode" ename "")
(setq value (read (cdr (assoc 1 (entget (entlast)))))
sw  1
)
)
((setq value (read (cdr (assoc 1 (entget ent))))))
 )
 (if (= sw 1)
(command ".undo" 1)
 )
 value
)
(defun OPT ()
 (if (null option)
(setq option "Replace"
  save2  option
)
 )
 (initget "Replace Create Do-nothing")
 (setq
option
(getkword
  	(strcat "\nOptions: [Replace/Create/Do-nothing] <"
   	option
   	"> "
  	)
)
 )
 (if (null option)
(setq option save2)
(setq save2 option)
 )
 (setq switch 1)
)
(defun ACTION (option result / txt pnt)
 (cond
((= option "Replace")
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
  	(princ "\n**NOTHING selected!**")
)
(setq txt (entget (car txt))
txt (subst (cons 1 result) (assoc 1 txt) txt)
)
(entmod txt)
)
((= option "Create")
(setq pnt (getpoint "\nSpecify start point of text:"))
(entmake (list (assoc 0 ent)
 	(assoc 8 ent)
 	(cons 1 result)
 	(cons 10 (trans pnt 1 0))
 	(assoc 40 ent)
 	(assoc 7 ent)
 	(assoc 50 ent)
  	)
)
)
 )
)
(defun GET-ORDER ()
 (princ (strcat "\nCurrent setting: Precision = "
  (rtos precision 2 0)
  " <"
  (rtos 0 2 precision)
  ">"
 )
 )
 (initget
"Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision"
 )
 (setq operation
 (getkword
(strcat
 	"\nOperations: [Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]: <"
 	operation
 	"> "
)
 )
 )
 (if (null operation)
(setq operation save1)
(setq save1 operation)
 )
)
;;***MAIN FUNCTION***:
(defun c:TCAL (/ Numbers   DIVIDEND  DIVISOR   ENT  ID
  INDEX	MINUEND   NUM-MAX   NUM-MIN  NUM-SET
  RESULT	SUBTRAHEND    	SWITCH  VALUE
  sw
 )
 (princ
"** Text calculation tool - Skywings **"
 )
 (setvar "CMDECHO" 0)
 (setvar "QAFLAGS" 1)
 (if (null precision)
(setq precision 2
  save3 precision
)
 )
 (if (null operation)
(setq operation "Plus"
  save1 operation
)
 )
 (GET-ORDER)
 (while (= operation "preCision")
(initget 4)
(setq
 	precision (getint (strcat "\nSpecify new precision: <"
(rtos precision 2 0)
"> "
  )
 )
)
(if (null precision)
 	(setq precision save3)
 	(setq save3 precision)
)
(GET-ORDER)
 )
 (cond
;; PLUS:
((= operation "Plus")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	result 0
  	)
  	(princ "\n>>Expression: ")
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(progn
 	(setq result (+ result value))
 	(if (/= index 1)
   	(princ " + ")
 	)
 	(princ (rtos value 2 precision))
)
 )
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option (rtos result 2 precision))
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
)
)
;; MULTIPLY:
((= operation "Multiply")
 	(GET-TEXT)
 	(setq switch 0)
 	(while (/= Numbers nil)
(GET-DATA)
(setq index 0
  	result 1
)
(princ "\n>>Expression: ")
(repeat (sslength Numbers)
  (setq ent   (entget (ssname Numbers index))
 value (read (cdr (assoc 1 ent)))
 index (1+ index)
  )
  (if (numberp value)
(progn
  	(setq result (* result value))
  	(if (/= index 1)
 (princ " * ")
  	)
  	(princ (rtos value 2 precision))
)
  )
)
(if (= sw 1)
  (command ".undo" 1)
)
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq Numbers nil
  	Numbers (ssget '((0 . "*TEXT")))
)
 	)
)
;; SUBTRACT:
((= operation "Subtract")
 	(setq switch 0
sw 0
 	)
 	(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
 	(setq minuend (GET-VALUE "MINUEND"))
 	(while (null (numberp minuend))
(while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : "))))))
(setq minuend (GET-VALUE "MINUEND"))
 	)
 	(princ minuend)
 	(redraw ename 3)
 	(princ "\nSelect SUBTRAHENDs : ")
 	(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect SUBTRAHENDs : ")
 	)
 	(redraw ename 4)
 	(while (/= ename nil)
(GET-DATA)
(setq index   0
  	result  0
  	minuend (float minuend)
)
(princ (strcat "\n>>Expression: "
	(rtos minuend 2 precision)
	" - ("
   	)
)
(repeat (sslength Numbers)
  (setq ent	(entget (ssname Numbers index))
 subtrahend (read (cdr (assoc 1 ent)))
 index	(1+ index)
  )
  (if (numberp subtrahend)
(progn
  	(setq result (+ result subtrahend))
  	(if (/= index 1)
 (princ " + ")
  	)
  	(princ (rtos subtrahend 2 precision))
)
  )
)
(princ ")")
(if (= sw 1)
  (command ".undo" 1)
)
(setq result (- minuend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
  	ename (car (entsel (strcat "\nSelect MINUEND : ")))
)
(if
  (or
(null ename)
(null (numberp (setq minuend (GET-VALUE "MINUEND"))))
  )
  (progn
(setvar "QAFLAGS" 0)
(vl-exit-with-error "")
  )
)
(princ minuend)
(princ "\nSelect SUBTRAHENDs <TEXT>: ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
  (princ "\nSelect SUBTRAHENDs : ")
)
 	)
)
;; DIVIDE:
((= operation "Divide")
 	(setq switch 0
sw 0
 	)
 	(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
 	(setq dividend (GET-VALUE "DIVIDEND"))
 	(while (null (numberp dividend))
(while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : "))))))
(setq dividend (GET-VALUE "DIVIDEND"))
 	)
 	(princ dividend)
 	(redraw ename 3)
 	(princ "\nSelect DIVISORs : ")
 	(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
(princ "\nSelect DIVISORs : ")
 	)
 	(redraw ename 4)
 	(while (/= ename nil)
(GET-DATA)
(setq index   0
  	result  1
  	dividend (float dividend)
)
(princ (strcat "\n>>Expression: "
	(rtos dividend 2 precision)
	" / ("
   	)
)
(repeat (sslength Numbers)
  (setq ent (entget (ssname Numbers index))
 divisor (read (cdr (assoc 1 ent)))
 index (1+ index)
  )
  (if (numberp divisor)
(progn
  	(setq result (* result divisor))
  	(if (/= index 1)
 (princ " * ")
  	)
  	(princ (rtos divisor 2 precision))
)
  )
)
(princ ")")
(if (= sw 1)
  (command ".undo" 1)
)
(setq result (/ dividend result))
(princ (strcat "\n>>RESULT = " (rtos result 2 precision)))
(if (= switch 0)
  (OPT)
)
(ACTION option (rtos result 2 precision))
(setq ename nil
  	ename (car (entsel (strcat "\nSelect DIVIDEND : ")))
)
(if
  (or
(null ename)
(null (numberp (setq dividend (GET-VALUE "DIVIDEND"))))
  )
  (progn
(setvar "QAFLAGS" 0)
(vl-exit-with-error "")
  )
)
(princ dividend)
(princ "\nSelect DIVISORs : ")
(while (null (setq Numbers (ssget '((0 . "*TEXT")))))
  (princ "\nSelect DIVISORs : ")
)
 	)
)
;; AVERAGE:
((= operation "Average")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	id 0
 	result 0
  	)
  	(princ "\n>>Expression: (")
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(progn
 	(setq result (+ result value)
id   (1+ id)
 	)
 	(if (/= index 1)
   	(princ " + ")
 	)
 	(princ (rtos value 2 precision))
)
 )
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(setq result (rtos (/ (float result) id) 2 precision))
  	(princ (strcat ") / " (rtos id 2 0)))
  	(princ (strcat "\n>>RESULT = " result))
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option result)
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
)
)
;; MAX-MIN:
((= operation "maX-min")
(GET-TEXT)
(setq switch 0)
(while (/= Numbers nil)
  	(GET-DATA)
  	(setq index 0
 	Num-set nil
  	)
  	(repeat (sslength Numbers)
 (setq ent   (entget (ssname Numbers index))
   	value (read (cdr (assoc 1 ent)))
   	index (1+ index)
 )
 (if (numberp value)
(setq Num-set (cons value Num-set))
 )
  	)
  	(setq Num-set (vl-sort Num-set '>)
 	num-max (car Num-set)
 	num-min (last Num-set)
 	result  (strcat "MAX = "
   	(rtos num-max 2 precision)
   	"  MIN = "
   	(rtos num-min 2 precision)
  	)
  	)
  	(if (= sw 1) (command ".undo" 1))
  	(princ "\n>>Numbers set: ")
  	(princ Num-set)
  	(print)
  	(princ result)
  	(if (= switch 0)
 (OPT)
  	)
  	(ACTION option result)
  	(setq Numbers nil
 	Numbers (ssget '((0 . "*TEXT")))
  	)
)
)
;; ADD-BY...:
((= operation "ADd-by")
(if (null number0)
  	(setq number0 0.00
 	save4 number0
  	)
)
(setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> "))
index   0
)
(if (null number0)
  	(setq number0 save4)
  	(setq save4 number0)
)
(GET-TEXT)
(GET-DATA)
(repeat (sslength Numbers)      
  	(setq ent   (entget (ssname Numbers index))
 	value (read (cdr (assoc 1 ent)))
 	index (1+ index)
  	)      
  	(if (numberp value)
 (setq value (+ (float value) number0)
   	ent   (subst (cons 1 (rtos value 2 precision))
  	(assoc 1 ent)
  	ent
  	)
 )
  	)
  	(entmod ent)      
)
)
;;MULTIPLY-BY...:
((= operation "mUltiply-by")
(if (null number0)
  	(setq number0 0.00
 	save4 number0
  	)
)
(setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> "))
index   0
)
(if (null number0)
  	(setq number0 save4)
  	(setq save4 number0)
)
(GET-TEXT)
(GET-DATA)
(repeat (sslength Numbers)
  	(setq ent   (entget (ssname Numbers index))
 	value (read (cdr (assoc 1 ent)))
 	index (1+ index)
  	)
  	(if (numberp value)
 (setq value (* (float value) number0)
   	ent   (subst (cons 1 (rtos value 2 precision))
  	(assoc 1 ent)
  	ent
  	)
 )
  	)
  	(entmod ent)
)
)
 )
 (princ "<Exit>")
 (setvar "QAFLAGS" 0)
 (princ)
)

Tcal dùng lựa chọn AD (add-by) nhập hằng số K là -K nếu muốn trừ, K nếu muốn cộng

Bạn ơi bạn có thể thêm tiền tố vào trước kết quả xuất ra không? ví dụ (+1) + (+1) = (+2) tương tự với các ký tự khác ví dụ (layer1: 1,2) + (3) = (layer1: 3,2).

Và thêm phần +,-,*,/ với số nhập từ bàn phím nữa thì quá tuyệt. Thanks:D

Tháng 6 11, 2012

Lisp dùng rất tuyệt bác Tue_NV.Nhưng nay em muốn bác viết bổ sung khả năng cộng hằng số vào text nằm trong attribute block có được không ạ.Em hi vọng rất nhiều.Đợi chờ sản phẩm của bác.

Tháng 6 11, 2012

Lisp dùng rất tuyệt bác Tue_NV.Nhưng nay em muốn bác viết bổ sung khả năng cộng hằng số vào text nằm trong attribute block có được không ạ.Em hi vọng rất nhiều.Đợi chờ sản phẩm của bác.

Bạn xem bài viết số 1356 nhé :

Chương trình tính toán Cộng trừ Nhân Chia giá trị của Block Attribute; Text với 1 số hoặc 1 biểu thức.

http://www.cadviet.com/forum/index.php?showtopic=13203&st=1340

Tháng 7 30, 2013

Bạn làm cho mình lisp " cộng hằng số K" này nhớ con số mình nhập vào, và Lisp chạy liên tục cho đến khi Enter để kết thúc lệnh với

Thank

Tháng 8 26, 2020

Vào lúc 14/4/2009 tại 22:12, Tue_NV đã nói:

Đây bạn :

cso.lsp
[✎]


(defun c:cso()
(setq olddim (getvar "dimzin"))
(setvar "DimZin" 0)

(setq en (ssget '((0 . "TEXT"))))
(setq tp (getint "\n So chu so thap phan :"))

(setq n (sslength en) i 0)

(if (null newo) (setq newo 1))

(setq new1 (getreal (strcat "\nNhap so can cong : ")))

(if (null new1) (setq new1 newo) (setq newo new1))

(while (
(setq ename (entget (ssname en i)))

(setq li (cdr (assoc 1 ename)))
(setq lis (+ (atof li) new1))

(setq ename (subst (cons 1 (rtos lis 2 tp)) (assoc 1 ename) ename))

(entmod ename)
(setq i (+ i 1))
)
(setvar "dimzin" olddim)
(princ)
)
;;;;

lisp này có 1 cái hơi buồn cười. Giả sử như trong 1 nhóm text được chọn để cộng hằng số mà có lẫn text là chữ (không phải số) thì nó thay cái chữ đó bằng chính hằng số luôn. ( theo tôi nghĩ là nó xem chữ cái là một số 0 và tiến hành + với hằng số)

Cái lisp này được cái hay là chọn được số chữ số thập phân.... mấy cái lisp khác tìm trên đây như lisp + - * / một hằng số toàn cho ra kết quả lấy số nguyên.

Đăng nhập

LISP cộng têxt toàn bộ bản vẽ thêm 1 hằng sô

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

khopanh 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

Tue_NV 3.912

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

tigertiger 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

Nguyen Trung Kien 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

Thaistreetz 539

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

truongthanh 7

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

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

hukhong 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

nguyenduy2112 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

phamthanhbinh 3.146

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

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

huunhantvxdts 195

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

ketxu 2.984

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

huunhantvxdts 195

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

bach1212 4

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

ketxu 2.984

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

victor85 10

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

longbyoongho 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

levanduy 74

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