Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác

Tháng 10 13, 2016

Nhờ các cao thủ viết giúp mình lisp như tựa đề.

Ví dụ cụ thể:

Trên bản vẽ có sẵn 2 hoặc nhiều text (hoặc mtext), chẳng hạn 2(text), 3(mtext) và 4(text).

Mình gõ lệnh (ví dụ "cộng"), click chọn vào 2, 3, và 4, sẽ được kết quả là 9, và output ra 1 mtext. Mình sẽ click chọn vị trí để output mtext này trên bản vẽ.

Cảm ơn nhiều! :D

Tháng 10 13, 2016

Nhờ các cao thủ viết giúp mình lisp như tựa đề.

Ví dụ cụ thể:

Trên bản vẽ có sẵn 2 hoặc nhiều text (hoặc mtext), chẳng hạn 2(text), 3(mtext) và 4(text).

Mình gõ lệnh (ví dụ "cộng"), click chọn vào 2, 3, và 4, sẽ được kết quả là 9, và output ra 1 mtext. Mình sẽ click chọn vị trí để output mtext này trên bản vẽ.

Cảm ơn nhiều! :D

Hóng nào hóng nào ^^

Bác check thử xem được chưa.

(defun c:congtext ()

(prompt "Moi Dai Ca Chon Text Giup Em ^^")

(setq sslist (ssget '((-4 . "<or")(0 . "TEXT")(0 . "MTEXT")(-4 . "or>"))))

(setq number (SSLENGTH sslist)

sum 0)

(repeat number

(setq Value (atof (cdr (assoc 1 (entget (ssname sslist 0))))))

(setq sum (+ sum value))

(ssdel (ssname sslist 0) sslist)

)

(setq ptext (getpoint "Moi Dai Ca chon diem chen Text ^^ \n"))

(command "-text" ptext "" "" (rtos sum 2 2))

(princ)

)

Tháng 10 13, 2016

Nhờ các cao thủ viết giúp mình lisp như tựa đề.

Ví dụ cụ thể:

Trên bản vẽ có sẵn 2 hoặc nhiều text (hoặc mtext), chẳng hạn 2(text), 3(mtext) và 4(text).

Mình gõ lệnh (ví dụ "cộng"), click chọn vào 2, 3, và 4, sẽ được kết quả là 9, và output ra 1 mtext. Mình sẽ click chọn vị trí để output mtext này trên bản vẽ.

Cảm ơn nhiều! :D

Test thử tí. ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOI value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 10 pt)
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum 2 2))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

 ;|«Visual LISP© Format Options»
;*** DO NOT add text below the comment! ***|;

Tháng 10 13, 2016

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

Test thử tí. ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOI value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 10 pt)
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum 2 2))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

 ;|«Visual LISP© Format Options»
;*** DO NOT add text below the comment! ***|;

Tháng 10 13, 2016

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

Thay đoạn code (cons 0 "TEXT") của bác Bee thành:

(cons 0 "MTEXT")

(cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))

:) :) :)

Tháng 10 13, 2016

Thank bác.

Không được bác ạ, bác kiểm tra lại giúp xem thử.

Lúc trước còn output ra được kết quả, còn giờ thì sau khi chọn điểm chèn thì ko thấy động tĩnh gì thêm :D

Thay đoạn code (cons 0 "TEXT") của bác Bee thành:

(cons 0 "MTEXT")

(cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))

:) :) :)

Tháng 10 13, 2016

Thank bác.

Tuy nhiên vẫn chưa đúng ý e lắm :)

+ Chỗ output bác có thể sửa giúp e thành định dạng mtext như yêu cầu ko? hiện tại bác đang để định dạng là text.

+ Một cái nữa là layer của output bác có thể lấy như layer của đối tượng đầu tiên ko? (layer của mtext "2").

MTEXT đây ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOF value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "MTEXT")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbMText") 
          (cons 10 (trans pt 1 0))
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

Tháng 10 13, 2016

MTEXT đây ^_^

(defun c:test  ()
  (if (not (setq ss (ssget '((0 . "*TEXT")))))
    (princ "\nBan da khong chon TEXT.")
    (progn
      (setq n 0)
      (setq sum 0)
      (repeat (sslength ss)
        (setq value (cdr (assoc 1 (entget (ssname ss n)))))
        (setq value (ATOF value))
        (setq sum (+ sum value))
        (setq n (1+ n))
        ) ;progn
      (setq pt (getpoint "\nChon diem chen text: "))
      (entmake
        (list
          (cons 0 "MTEXT")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbMText") 
          (cons 10 (trans pt 1 0))
          (cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
          (cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
          (cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))
          (cons 1 (rtos sum))
          (cons 50 0)
          )
        )
      )
    )
  (princ)
  )

Thiếu mất 2 dòng của bác ^_^ ^_^ Quên cũng chưa check thử.

Mà hỏi bác xíu. Làm sao khi Entmake mình biết các giá trị DXF nào bắt buộc phải có khi tạo 1 đối tượng mới nhỉ :D :D

Ko biết thì hỏi, muốn giỏi phải học thôi @@

Tháng 10 13, 2016

Quick code xem bạn dùng cái nào thì dùng ^^

Vanilla lisp

(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))

- Visual lisp :

(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)

- Hoặc kết hợp với acet

(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))

Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....

Tháng 10 13, 2016

Thank các cao thủ nhiều :D

Em đã có được lệnh như mong muốn :D

Tháng 10 13, 2016

@Bác Bee :
Đoạn này tương đối không hợp lý vì entget lại 3 lần, hơn nữa tự hàm assoc đã trả về một assoc list rồi, k cần thiết phải cons lại nó nữa

(cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
(cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
(cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))

Tháng 10 13, 2016

@Bác Bee :

Đoạn này tương đối không hợp lý vì entget lại 3 lần, hơn nữa tự hàm assoc đã trả về một assoc list rồi, k cần thiết phải cons lại nó nữa
(cons 40 (cdr (assoc 40 (entget (ssname ss 0)))))
(cons 8 (cdr (assoc 8 (entget (ssname ss 0)))))
(cons 7 (cdr (assoc 7 (entget (ssname ss 0)))))

Uhm, tiện thể copy trên xuống nên ko nghĩ ngợi gì ^_^

Thay

(assoc 40 (entget (ssname ss 0))) là ok. :D

Ketxu soi chuẩn đấy ^_^

Tháng 10 13, 2016

Các lisp trên còn 1 vấn đề nữa là: thoát không êm khi getpoint = nil

Tháng 10 13, 2016

Các lisp trên còn 1 vấn đề nữa là: thoát không êm khi getpoint = nil

Quick code chỉ cần thế là giải quyết dc vấn đề. Chủ thớt Ok là xong. ^_^

Tháng 10 13, 2016

Quick code chỉ cần thế là giải quyết dc vấn đề. Chủ thớt Ok là xong. ^_^

Nếu vậy thì không có các bài: #11 và #12 cũng Ok.

Tháng 10 13, 2016

Quick code xem bạn dùng cái nào thì dùng ^^

Vanilla lisp

(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))

- Visual lisp :

(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)

- Hoặc kết hợp với acet

(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))

Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....

bác bày cho e cách sửa lisp al từ mtext thành text được ko ạ? e sửa mtext thành text+ bỏ 2 dòng dưới mà nó ko ra kết quả ạ :)

Tháng 10 13, 2016

bác bày cho e cách sửa lisp al từ mtext thành text được ko ạ? e sửa mtext thành text+ bỏ 2 dòng dưới mà nó ko ra kết quả ạ :)

xem cái repply 3 nhé.

Tháng 10 14, 2016

xin chào
nhờ anh em viết dùm mình lsp như vầy : mình có nhiều bản vẽ và muốn đánh dấu từ 01 đến 99 vào 1 khung số thứ tự , mình muốn quét chọn từ trái -> phải thì các số nhảy thứ tự tăng lên được ko ạ,
Cám ơn anh em! :)

Tháng 10 14, 2016

xin chào

nhờ anh em viết dùm mình lsp như vầy : mình có nhiều bản vẽ và muốn đánh dấu từ 01 đến 99 vào 1 khung số thứ tự , mình muốn quét chọn từ trái -> phải thì các số nhảy thứ tự tăng lên được ko ạ,

Cám ơn anh em! :)

Chung chung thế này thì bạn chờ cao thủ viết nhé. ^_^

Tháng 10 15, 2016

Xin chào các anh. Mình tìm trên diễn đàn thấy cái này gần như cái em mong muốn. Nhờ các anh sửa giúp em bước sau cùng là output ra text mới thì sửa lại thành chọn text có sãn để thay đổi kết quả. Em cảm ơn cá anh.

Ví dụ: Text 1: 22.5

Text 2: 10,5

Text 3: 2,34.

Khi đó cộng Text 1 và Text 2 lại cho kết quả nhấp chọn vào Text 3 sẽ cho kết quả Text 3: 23,00

Em cảm ơn các anh.

Tháng 10 15, 2016

Xin chào các anh. Mình tìm trên diễn đàn thấy cái này gần như cái em mong muốn. Nhờ các anh sửa giúp em bước sau cùng là output ra text mới thì sửa lại thành chọn text có sãn để thay đổi kết quả. Em cảm ơn cá anh.

Ví dụ: Text 1: 22.5

Text 2: 10,5

Text 3: 2,34.

Khi đó cộng Text 1 và Text 2 lại cho kết quả nhấp chọn vào Text 3 sẽ cho kết quả Text 3: 23,00

Em cảm ơn các anh.

Của bạn đây:

(defun c:congtext ()

(setq object (ssget '((0 . "*TEXT")))

number 0)

(repeat (sslength object)

(progn

(setq number (+ number (atof (cdr (assoc 1 (entget (ssname object 0)))))))

(ssdel (ssname object 0) object)

)

;;;;; Chon text thay ket qua

(setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

(setq sstext (subst (cons 1 (rtos number 2 2)) (assoc 1 (entget sstext)) (entget sstext)))

(ENTMOD sstext)

(princ)

)

Tháng 10 15, 2016

Chạy LISP này thử coi.

Của bạn đây:

(defun c:congtext ()

(setq object (ssget '((0 . "*TEXT")))

number 0)

(repeat (sslength object)

(progn

(setq number (+ number (atof (cdr (assoc 1 (entget (ssname object 0)))))))

(ssdel (ssname object 0) object)

)

)

;;;;; Chon text thay ket qua

(setq sstext (car (entsel "Chon Text Thay Ket Qua ")))

(setq sstext (subst (cons 1 (rtos number 2 2)) (assoc 1 (entget sstext)) (entget sstext)))

(ENTMOD sstext)

(princ)

)

Tháng 10 15, 2016

Chạy LISP này thử coi.

Dạ được rồi anh. Em cảm ơn anh.

Tháng 10 17, 2016

Chung chung thế này thì bạn chờ cao thủ viết nhé. ^_^

* tks bạn, ý mình là vầy

mình có 10 bản vẽ mình mỗi 1 bv có 1 ô số thứ tự, mình muốn đánh số từ 01-02-03-...-10 mà ko làm thủ công, vậy anh em nghiên cứu dùm mình với :)

Đăng nhập

Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác

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

mivudemen 27

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

Danh Cong 422

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

Bee 154

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

mivudemen 27

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

Danh Cong 422

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

mivudemen 27

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

Bee 154

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

Danh Cong 422

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

mivudemen 27

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 2.984

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Bee 154

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

quocmanh04tt 635

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

Bee 154

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

quocmanh04tt 635

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

txquychk51 2

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Bee 154

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

toaneurowindow 7

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

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Bee 154

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

hotanphi 0