Đến nội dung


Hình ảnh
- - - - -

TCAL - Text calculation tool


  • Please log in to reply
19 replies to this topic

#1 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 29 March 2011 - 11:26 AM

- Bao gồm các phép tính đơn giản mà mình hay dùng :
Plus - cộng các số, Subtract - trừ 1 số với nhiều số, Multiply - nhân các số, Divide - chia một số với nhiều số, Average - tính trung bình, Max-min - số lớn nhất, nhỏ nhất trong các tập hợp chọn, Add by - cộng các số với một số cho trước, Multiply by - nhân các số với một số cho trước, Precision - độ chính xác của kết quả.
- Tùy chọn xuất kết quả: ghi đè lên 1 Text, tạo Text mới hoặc chỉ xem.
- Xuất biểu thức để kiểm tra, hỗ trợ vòng lặp cho 1 phép tính.
;;----------------------------------------------;;
;; 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 ename))))))
)
(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)
)

Bài viết đã được chỉnh sửa nội dung bởi Skywings: 24 April 2012 - 03:30 PM

  • 3

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 March 2011 - 11:54 AM

Thanks bạn, lisp chạy mượt và êm. Nếu chuyển sang DCL nữa thì :">
P/S : bạn có thể chọn cả Mtext, lọc số trong text nữa thì đẹp hơn r. Mình rất thích cách bạn cho lựa chọn ghi, hoặc replace ^^
  • 1

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


#3 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 29 March 2011 - 11:23 PM

Bác ketxu hoạt động năng nổ thật ^_^ !
Chưa hiểu ý bác muốn chuyển sang DCL thế nào, nếu bật chế độ Dynamic Input của CAD khi chạy chương trình sẽ thấy các function của chương trình được liệt kê rất gọn gàng và dễ sử dụng không cần đến hộp thoại nữa.
Lí do mình không muốn áp dụng cho MTEXT bởi vì nhiều khi nó kẹp đủ thứ linh tinh với nội dung chính, ví dụ như một 1 MTEXT có nội dung hiển thị trên màn hình là 150 nhưng trong bảng properties của nó nội dung lại là {\\fVNI-Helve|b0|i0|c0|p2;\\W0.9;150}, với cái mớ bòng bong đó hog biết trích xuất con số đó ra thế nào :wacko: , do đó để đảm bảo kết quả chính xác mình chọn giải pháp đơn giản là nổ nó ra thành TEXT ^_^ !
Đối với TEXT thì cứ yên tâm chọn lẫn lộn chữ và số, chương trình đã có thể xác định được text nào là số để đưa vào tính toán!
  • 1

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 30 March 2011 - 12:16 AM

Bác ketxu hoạt động năng nổ thật ^_^ !
Chưa hiểu ý bác muốn chuyển sang DCL thế nào, nếu bật chế độ Dynamic Input của CAD khi chạy chương trình sẽ thấy các function của chương trình được liệt kê rất gọn gàng và dễ sử dụng không cần đến hộp thoại nữa.
Lí do mình không muốn áp dụng cho MTEXT bởi vì nhiều khi nó kẹp đủ thứ linh tinh với nội dung chính, ví dụ như một 1 MTEXT có nội dung hiển thị trên màn hình là 150 nhưng trong bảng properties của nó nội dung lại là {\\fVNI-Helve|b0|i0|c0|p2;\\W0.9;150}, với cái mớ bòng bong đó hog biết trích xuất con số đó ra thế nào :wacko: , do đó để đảm bảo kết quả chính xác mình chọn giải pháp đơn giản là nổ nó ra thành TEXT ^_^ !
Đối với TEXT thì cứ yên tâm chọn lẫn lộn chữ và số, chương trình đã có thể xác định được text nào là số để đưa vào tính toán!

Góp vui: Bác có thể dùng tạm 2 hàm dưới đây để xử mấy thằng mtext hầm bà lằng đó (do sửa font thôi)
Vì nó có ngoằn nghèo gì thì giá trị sau dấu ";" cuối cùng vẫn là giá trị "thực" của text.
(STRP "mtext" ";")
Các hàm này tôi đã lập từ lâu lắm rồi nên chắc không "đẹp" lắm.
----
; Cac ham xu ly chuoi ky tu.
(defun Findstr (Str Search / Index Find) (setq Index 0) (while (and (/= Find Search) (<= Index (- (strlen Str) (strlen Search)))) (setq Index (1+ Index)) (setq Find (substr Str Index (strlen Search)))) (if (= Find Search) Index nil))
; Lay phan ben phai cua chuoi str ke tu ky tu x cuoi cung.
(defun STRP(str x) (while (setq st (findstr str x)) (setq str (substr str (+ st 1)))) str)
;
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 30 March 2011 - 08:21 AM

Thks bác Hà đã góp vui, 2 hàm của bác chạy tốt ở truờng hợp mình đưa ra ở trên, nhưng nếu chỉ dựa vào ký tự ";" để lọc thì vẫn chưa đủ vì mình còn gặp truờng hợp này "\Ftxt.shx;\W1.0000000000;\T1.0000000000;\o\l117.67" :( !
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 March 2011 - 08:26 AM

Bác ketxu hoạt động năng nổ thật ^_^ !
Chưa hiểu ý bác muốn chuyển sang DCL thế nào, nếu bật chế độ Dynamic Input của CAD khi chạy chương trình sẽ thấy các function của chương trình được liệt kê rất gọn gàng và dễ sử dụng không cần đến hộp thoại nữa.
Lí do mình không muốn áp dụng cho MTEXT bởi vì nhiều khi nó kẹp đủ thứ linh tinh với nội dung chính, ví dụ như một 1 MTEXT có nội dung hiển thị trên màn hình là 150 nhưng trong bảng properties của nó nội dung lại là {\\fVNI-Helve|b0|i0|c0|p2;\\W0.9;150}, với cái mớ bòng bong đó hog biết trích xuất con số đó ra thế nào :wacko: , do đó để đảm bảo kết quả chính xác mình chọn giải pháp đơn giản là nổ nó ra thành TEXT ^_^ !
Đối với TEXT thì cứ yên tâm chọn lẫn lộn chữ và số, chương trình đã có thể xác định được text nào là số để đưa vào tính toán!

Góp ý chủ quan thôi :
- Hề, nếu DCL thì sẽ có vô vàn thứ được rút gọn, cái Do - Nothing sẽ được hiển thị ngay, còn code thì dài ra ^^ Mình bao giờ cũng để DYN, nhưng rất ngại mỗi khi menu xổ xuống ^^ Nói chung để tính toán thật thì như ni là đủ r ^^
- Về vấn đề MText thì chỉ là việc xử lý chuỗi ký tự thôi, chắc chắn không có gì khó với bạn ^^ (khó với mình ^^)
Còn nếu nó hầm bà lằng quá nhiều thứ option mà ngại mần, bạn có thể tạm thời explode ra ở đầu lisp với tất cả Mtext, cuối lisp ta Undo, không ảnh hưởng gì đến kết quả thu được ^^
  • 1

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


#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 30 March 2011 - 09:37 AM

Góp ý chủ quan thôi :
- Hề, nếu DCL thì sẽ có vô vàn thứ được rút gọn, cái Do - Nothing sẽ được hiển thị ngay, còn code thì dài ra ^^ Mình bao giờ cũng để DYN, nhưng rất ngại mỗi khi menu xổ xuống ^^ Nói chung để tính toán thật thì như ni là đủ r ^^
- Về vấn đề MText thì chỉ là việc xử lý chuỗi ký tự thôi, chắc chắn không có gì khó với bạn ^^ (khó với mình ^^)
Còn nếu nó hầm bà lằng quá nhiều thứ option mà ngại mần, bạn có thể tạm thời explode ra ở đầu lisp với tất cả Mtext, cuối lisp ta Undo, không ảnh hưởng gì đến kết quả thu được ^^

P/S Skywings: ai ngờ "đời" nó còn lắm thứ rối rắm như thế, tưởng chỉ có thằng ";" chứ. Cám ơn Bác.
P/S Ketxu: chiêu này "đểu" mà "độc". Đã có lần dùng chiêu này cho mấy thằng khác rồi mà quên mất thằng "mtext" này. Cám ơn Bác.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 30 March 2011 - 09:43 PM

@ ketxu: bác quá đề cao mình rùi, mình cũng chỉ là dân a-ma-tơ thui ^^!! Ý kiến nổ MTEXT ra để xử lí cũng hay, nhưng mà làm biếng code lại quá :D , với lại cũng ngại dùng lệnh Command lặp tới lặp lui, xử lí nhiều đối tượng sẽ làm chương trình chạy lê lết :huh: !
@ Doan Van Ha: chuyện "đời" nó hay phức tạp như thế ^^!
  • 0

#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 March 2011 - 10:10 PM

Code có lâu đâu nhỉ ^^ Bạn explode 1 lần hết tất cả, r cũng undo hết tất cả chứ ^^ Dùng thủ thuật lấy lại toàn bộ Text sau khi explode và xử lý, mình nghĩ chỉ thêm 4,5 dòng gì đó thôi ^^
  • 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


#10 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 31 March 2011 - 09:25 AM

Chắc phải nhờ bác ketxu ra tay thui!
Mình đã thử thế này: (command ".explode" Numbers)
với Numbers là <selection set>
nhưng kết quả nó chỉ explode được 1 đối tượng trong tập hợp.
còn nếu dùng (command ".erase" Numbers "")
thì "bay" hết cả tập hợp.
Có ai giải thích giùm mình hog :huh: ??
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 31 March 2011 - 10:01 AM

^^ Có sự khác biệt giữa 2 em này.
- Với Explode, nếu chẳng may tập ss của bạn có 1 đối tượng không explode được, hoặc đối tượng sau khi explode k tiếp tục explode đc nữa, hoặc sao sao sao đó, miễn là có vấn đề, thì nó dừng lại ^^ Thành ra bác Autodesk nhà mình cũng để mặc định explode em đầu tiên hay sao ý ^^
- Còn với Erase, chẳng vướng gì cả, thằng nào nó cũng cho bay hết ^^
Thành ra, nếu bạn muốn bung 1 ss, bạn có thể dùng vòng lặp, hoặc dùng thủ thuật chọn nó :

(sssetfirst nil (ssget))
(command "._explode")

Nếu sợ highlight + grip làm chậm khi chọn nhiều đối tượng thì bạn có thể bỏ nó đi

Update : Có thể thay đổi biến qaflags sau đó mái thoải :

(setvar "qaflags" 1)
(command "_.explode" ss "")


  • 1

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


#12 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 March 2011 - 10:04 AM

Chắc phải nhờ bác ketxu ra tay thui!
Mình đã thử thế này: (command ".explode" Numbers)
với Numbers là <selection set>
nhưng kết quả nó chỉ explode được 1 đối tượng trong tập hợp.
còn nếu dùng (command ".erase" Numbers "")
thì "bay" hết cả tập hợp.
Có ai giải thích giùm mình hog :huh: ??

Đơn giản : Bạn sử dụng hàm
(acet-explode (ssget))
-> Kết quả lấy lại tập đối tượng đã explode ra trong tập (ssget)
  • 3

#13 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 05 April 2011 - 03:10 PM

Cám ơn 2 bác ketxu và Tue_NV đã giúp đỡ, kết hợp thay đổi biến hệ thống QAFLAGS và dùng hàm ACET-EXPLODE để lấy được tập đối tượng explode quả là rất hay :) ! Mà sao biến QAFLAGS và hàm ACET-EXPLODE không thấy được đề cập trong mục Help của CAD nhỉ?

* Code đã được cập nhật mới hỗ trợ cả TEXT và MTEXT !!!
(Cửa sổ code sao không có thanh cuộn để gọn gàng ta ?!?!)
  • 1

#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 April 2011 - 03:52 PM

Cám ơn bạn, nhưng có vẻ code.. quá khủng ^^ Hehe
Còn ACET là một bộ cửu âm chân kinh truyền miệng, hok có trong CAD help r ^^
  • 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


#15 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 April 2011 - 09:26 PM

Cám ơn 2 bác ketxu và Tue_NV đã giúp đỡ, kết hợp thay đổi biến hệ thống QAFLAGS và dùng hàm ACET-EXPLODE để lấy được tập đối tượng explode quả là rất hay :) ! Mà sao biến QAFLAGS và hàm ACET-EXPLODE không thấy được đề cập trong mục Help của CAD nhỉ?

* Code đã được cập nhật mới hỗ trợ cả TEXT và MTEXT !!!
(Cửa sổ code sao không có thanh cuộn để gọn gàng ta ?!?!)

Mình thấy đoạn này trong code hình như bạn viết lặp đi lặp lại 4, 5 lần
(ssget '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(-4 . "OR>")
)
)

Bạn có thể thay thành 1 dòng như thế này :
(ssget '((0 . "*TEXT")))
là được.
  • 1

#16 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 05 April 2011 - 09:58 PM

Các bạn xem qua phần format của MTEXT đề phòng khi cần ghi Text vào CAD mà muốn format tí cho nó đẹp.
Bấm F1
User's Guide > Annotate Drawings > Notes and Labels > Use an Alternate Text Editor >
Format Multiline Text in an Alternate Text Editor
  • 1

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#17 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 07 April 2011 - 08:43 AM

@ketxu: mình đã cố gắng đơn giản code trong khả năng của mình :mellow: ! Thì ra bộ ACET- là bí kíp ko đuợc phổ biến ^^!
@Tue_NV: cám ơn bác, trông gọn gàng hơn nhiều ^^!
@Detailing: thông tin của bác rất có ích ^_^ !
  • 1

#18 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 April 2011 - 05:53 AM

^^ Có sự khác biệt giữa 2 em này.
- Với Explode, nếu chẳng may tập ss của bạn có 1 đối tượng không explode được, hoặc đối tượng sau khi explode k tiếp tục explode đc nữa, hoặc sao sao sao đó, miễn là có vấn đề, thì nó dừng lại ^^ Thành ra bác Autodesk nhà mình cũng để mặc định explode em đầu tiên hay sao ý ^^
- Còn với Erase, chẳng vướng gì cả, thằng nào nó cũng cho bay hết ^^
Thành ra, nếu bạn muốn bung 1 ss, bạn có thể dùng vòng lặp, hoặc dùng thủ thuật chọn nó :

Nếu sợ highlight + grip làm chậm khi chọn nhiều đối tượng thì bạn có thể bỏ nó đi

Update : Có thể thay đổi biến qaflags sau đó mái thoải :



Đơn giản : Bạn sử dụng hàm
(acet-explode (ssget))
-> Kết quả lấy lại tập đối tượng đã explode ra trong tập (ssget)



Cám ơn 2 bác ketxu và Tue_NV đã giúp đỡ, kết hợp thay đổi biến hệ thống QAFLAGS và dùng hàm ACET-EXPLODE để lấy được tập đối tượng explode quả là rất hay :) ! Mà sao biến QAFLAGS và hàm ACET-EXPLODE không thấy được đề cập trong mục Help của CAD nhỉ?

* Code đã được cập nhật mới hỗ trợ cả TEXT và MTEXT !!!
(Cửa sổ code sao không có thanh cuộn để gọn gàng ta ?!?!)


Đỏ : Hôm qua có việc dùng acet-explode mới ngớ ra câu này của bạn. Đúng là nếu không chuyển qaflags về 1 thì acet-explode cũng chỉ tình thương mến thương em đầu, chứ chưa đơn giản như bác Tuệ nói ^^ (mặc dù trong help đối số của nó là ss).Tks skywing 1 cái ^^
  • 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


#19 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 24 April 2012 - 01:51 PM

- Bao gồm các phép tính đơn giản mà mình hay dùng :
Plus - cộng các số, Subtract - trừ 1 số với nhiều số, Multiply - nhân các số, Divide - chia một số với nhiều số, Average - tính trung bình, Max-min - số lớn nhất, nhỏ nhất trong các tập hợp chọn, Add by - cộng các số với một số cho trước, Multiply by - nhân các số với một số cho trước, Precision - độ chính xác của kết quả.
- Tùy chọn xuất kết quả: ghi đè lên 1 Text, tạo Text mới hoặc chỉ xem.
- Xuất biểu thức để kiểm tra, hỗ trợ vòng lặp cho 1 phép tính.

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

E không hiểu tự nhiên bây giờ mang ra dùng lisp này, đối tượng là text, khi dùng TCAL để trừ và chia thì đều báo lỗi:
Command: TCAL
** Text calculation tool - Skywings **
Current setting: Precision = 2 <0.00>
Operations:
[Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]:
<Subtract> S

Select MINUEND :
Select MINUEND : ; error: bad argument type: lentityp nil

Select DIVIDEND :
Select DIVIDEND : ; error: bad argument type: lentityp nil
  • 0

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

 

 


#20 Skywings

Skywings

    biết lệnh erase

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

Đã gửi 24 April 2012 - 03:32 PM

Đã sửa lỗi, cám ơn bạn đã phát hiện :), bạn down lại lisp nhé!
  • 1