Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
mivudemen

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ị

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

  • Vote giảm 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

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

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

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

  • Vote tăng 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

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

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

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

 

:)  :)  :) 

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

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

 

:)  :)  :) 

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

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

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

 

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

  • 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

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

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

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

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

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ả ạ :)

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 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é. 

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

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

  • Vote giảm 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

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é. ^_^

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

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.

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

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

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

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

 

  • Vote giảm 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

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  

×