Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Skywings

TCAL - Text calculation tool

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

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

Chỉnh sửa theo Skywings
  • Vote tăng 3

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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!

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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)

;

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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" :( !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.

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: 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ế ^^!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

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

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

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

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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)

  • Vote tăng 3

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

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

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

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.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

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

- 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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×