Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
23 replies to this topic

#1 mivudemen

mivudemen

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 October 2016 - 08:59 AM

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


  • -1

#2 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 259 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 13 October 2016 - 10:50 AM

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

  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#3 Bee

Bee

    biết lệnh extend

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

Đã gửi 13 October 2016 - 10:58 AM

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


  • 2

#4 mivudemen

mivudemen

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 October 2016 - 01:22 PM

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


  • 0

#5 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 259 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 13 October 2016 - 01:55 PM

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

 

:)  :)  :) 


  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#6 mivudemen

mivudemen

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 October 2016 - 02:07 PM

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

 

:)  :)  :) 


  • 0

#7 Bee

Bee

    biết lệnh extend

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

Đã gửi 13 October 2016 - 02:13 PM

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

  • 0

#8 Danh Cong

Danh Cong

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 259 Bài viết
Điểm đánh giá: 43 (tàm tạm)

Đã gửi 13 October 2016 - 02:38 PM

 

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


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 October 2016 - 02:40 PM

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


#10 mivudemen

mivudemen

    biết vẽ line

  • Members
  • PipPip
  • 29 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 13 October 2016 - 04:01 PM

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

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


  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 October 2016 - 05:19 PM

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

  • 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


#12 Bee

Bee

    biết lệnh extend

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

Đã gửi 13 October 2016 - 05:25 PM

 

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


  • 0

#13 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 13 October 2016 - 05:39 PM

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


  • 0

#14 Bee

Bee

    biết lệnh extend

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

Đã gửi 13 October 2016 - 05:47 PM

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


  • 0

#15 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 13 October 2016 - 06:03 PM

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.


  • 0

#16 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 13 October 2016 - 08:38 PM

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


  • 0

#17 Bee

Bee

    biết lệnh extend

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

Đã gửi 13 October 2016 - 10:21 PM

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


  • 0

#18 toaneurowindow

toaneurowindow

    biết zoom

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

Đã gửi 14 October 2016 - 11:03 AM

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


  • -1

#19 Bee

Bee

    biết lệnh extend

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

Đã gửi 14 October 2016 - 07:49 PM

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


  • 0

#20 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 15 October 2016 - 08:17 AM

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.


  • 0