Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
20 replies to this topic

#1 khopanh

khopanh

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 April 2009 - 09:43 PM

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

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 14 April 2009 - 10:12 PM

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

  • 9

#3 tigertiger

tigertiger

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 July 2009 - 04:08 PM

Đâ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
  • 1

#4 Nguyen Trung Kien

Nguyen Trung Kien

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 July 2009 - 05:14 PM

Đâ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:
  • 0

#5 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 13 July 2009 - 02:01 AM

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

  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#6 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 26 October 2009 - 03:16 PM

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

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 26 October 2009 - 03:36 PM

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

#8 hukhong

hukhong

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 October 2010 - 10:51 AM

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


  • 0

#9 nguyenduy2112

nguyenduy2112

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 01 August 2011 - 09:43 AM

Đâ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.
  • 0

#10 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 01 August 2011 - 03:19 PM

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ề.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#11 dautuan.esgc

dautuan.esgc

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 April 2012 - 10:32 AM

thanks các bác
  • 0

#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 21 April 2012 - 02:41 PM

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

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 21 April 2012 - 03:18 PM

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 ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 22 April 2012 - 10:32 PM

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ĩ.
­
  • 0

#15 bach1212

bach1212

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 23 April 2012 - 10:21 AM

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

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#16 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 23 April 2012 - 11:15 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#17 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 23 April 2012 - 11:44 AM

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

#18 longbyoongho

longbyoongho

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 03 May 2012 - 10:43 AM

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
  • 0
Đã 18 mùa cây lúa trổ bông,
Chưa 1 lần sờ mông con gái
Cũng từng ấy mùa khoai sọ,
Chưa 1 lần này nọ với ai.

#19 levanduy

levanduy

    biết lệnh offset

  • Members
  • PipPipPip
  • 176 Bài viết
Điểm đánh giá: 73 (tàm tạm)

Đã gửi 11 June 2012 - 03:02 PM

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.
  • 0
Only dead fish go with the stream!

#20 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 11 June 2012 - 03:24 PM

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.c...c=13203&st=1340
  • 1