[Yêu cầu] Lisp chỉnh sửa nội dung text

[tinya1225 36]

Chào các bác. em có 1 vấn đề thế này. trong bản vẽ có khoảng 50 text với số thứ tự (XX-01) đến (XX-50), mỗi text ứng với 1 thiết bị nhất định, khi em muốn thêm vào khoảng giữa 1 vài thiết bị khác (kèm theo text) thì số thứ tự các thiết bị sau sẽ bị đẩy lùi tùy số lượng thiết bị thêm vào. em muốn xin 1 lisp có tác dụng cộng thêm 1 giá trị n ( n=1,2,3...) vào những text được trọn (quét hoặc pick), tất nhiên là chỉ cộng thêm vào với dạng số còn dạng chữ thì giữ nguyên: (XX-01)+ 2 = (XX-03)

em cám ơn và chúc cả nhà 1 ngày may mắn.

[ketxu 2.984]

Chính xác dạng text của bạn là như thế nào ? Chỉ có XX-Số thôi ?

[tinya1225 36]

Chính xác dạng text của bạn là như thế nào ? Chỉ có XX-Số thôi ?

dạng text của em là (XX-số)

với xx là ký hiệu riêng của từng thiết bị ở dạng chữ cái như là EF, AC...

số là số hiệu của thiết bị đi kèm

có dấu ngoặc đơn hoặc ko cũng đc

thanks bác đã reply

[duy782006 1.533]

dạng text của em là (XX-số)

với xx là ký hiệu riêng của từng thiết bị ở dạng chữ cái như là EF, AC...

số là số hiệu của thiết bị đi kèm

có dấu ngoặc đơn hoặc ko cũng đc

thanks bác đã reply

"hoặc" + "cũng được" = chán.

[tinya1225 36]

"hoặc" + "cũng được" = chán.

dạ thật ra là có nhưng cái đó không quan trọng lắm nên e nói ko có cũng đc bác ah.

em cũng ko hiểu ý bác lắm phải chăng bác muốn yêu cầu cụ thể và chính xác :unsure:

[ketxu 2.984]

Mình không rành xử lý string lắm, mà chính xác là hok thích lắm. Viết như thế này, bạn thử xem có dùng được hem :

(defun c:++(/ num kq oldvalue str)
(setq num (getint "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq kq (vl-string-subst 
(rtos (+ num (atoi (setq oldvalue (substr 
	(setq str (vlax-get-property ent 'TextString))
	(+ 2 (vl-string-position (ascii "-") str)) 
)))) 2 0)
oldvalue
str
))
(if (=(substr str (strlen str))  ")")(setq kq (strcat kq ")")))
(vlax-put-property ent 'TextString kq))
)

- Lệnh ++

- Cho phép chọn nhiều MText, Text (chú ý phải chọn nhé ^^)

- Chấp nhận kiểu text " xxx....xxxx - số (có hoặc k có ngoặc)"

[tinya1225 36]

Mình không rành xử lý string lắm, mà chính xác là hok thích lắm. Viết như thế này, bạn thử xem có dùng được hem :

(defun c:++(/ num kq oldvalue str)
(setq num (getint "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq kq (vl-string-subst 
(rtos (+ num (atoi (setq oldvalue (substr 
	(setq str (vlax-get-property ent 'TextString))
	(+ 2 (vl-string-position (ascii "-") str)) 
)))) 2 0)
oldvalue
str
))
(if (=(substr str (strlen str))  ")")(setq kq (strcat kq ")")))
(vlax-put-property ent 'TextString kq))
)

cám ơn bác đã bỏ công sức giúp em.

em đã chạy lệnh báo lỗi như sau:

 

Command: ++

 

Số cần cộng thêm :1

 

Select objects: 1 found

 

Select objects:

; error: no function definition: nil

 

đã thử với text, mtext, dtext

mong bác tiếp tục giúp em.

[ketxu 2.984]

Bạn thêm dòng (vl-load-com) vào đầu hoặc cuối lisp hộ mình, có khả năng chưa load VL

[tinya1225 36]

Bạn thêm dòng (vl-load-com) vào đầu hoặc cuối lisp hộ mình, có khả năng chưa load VL

ok ngon rùi bác a. thanks bác nhiều nhiều. nhưng có 1 vấn đề nho nhỏ. text của e là (XX - 01) khi chạy với n=1 xong thì kết quả là (XX -02), Bác chỉ giúp e để nó có dấu cách giữa "-" và "02" với a.

[tinya1225 36]

Đây là lisp e bác ketxu đã viết cho em: http://www.cadviet.com/upfiles/3/2b2b.lsp

Tác dụng của lisp: http://www.cadviet.com/forum/index.php?showtopic=43745&st=0&p=149882&fromsearch=1entry149882

 

Trong quá trình sử dụng em có 1 vài vấn đề như sau mong các bác sửa giúp:

- Text dạng (EF - 1) khi dùng lisp với giá trị tăng thêm 2 cho kết quả (EF -3), em muốn sửa để có dấu cách giữa "-" và "3": (EF - 3)

- Với text dạng (EF - 10.1) với giá trị tăng thêm 2 cho kết quả (EF - 12), em muốn kết quả có dạng (EF - 12.1)

 

Mong được các bác giúp đỡ. Em cám ơn và chúc các bác 1 ngày tốt lành :rolleyes:

[pdle 126]

Đây là lisp e bác ketxu đã viết cho em: http://www.cadviet.com/upfiles/3/2b2b.lsp

Tác dụng của lisp: http://www.cadviet.com/forum/index.php?showtopic=43745&st=0&p=149882&fromsearch=1entry149882

 

Trong quá trình sử dụng em có 1 vài vấn đề như sau mong các bác sửa giúp:

- Text dạng (EF - 1) khi dùng lisp với giá trị tăng thêm 2 cho kết quả (EF -3), em muốn sửa để có dấu cách giữa "-" và "3": (EF - 3)

- Với text dạng (EF - 10.1) với giá trị tăng thêm 2 cho kết quả (EF - 12), em muốn kết quả có dạng (EF - 12.1)

 

Mong được các bác giúp đỡ. Em cám ơn và chúc các bác 1 ngày tốt lành :rolleyes:

 

1. Em đã sửa lisp đó, cho phép giá trị cộng thêm có thể là số thực bất kỳ

2. Làm như đúng ý của anh

3. Lisp anh ketxu viết gọn quá, hâm mộ :D

4. Nhưng cái này chỉ làm việc khi không có ngoặc đơn!

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43745&st=0&gopid=149909entry149909
(defun c:++(/ num kq oldvalue str)
(setq num (getreal "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq kq (vl-string-subst 
(strcat " "(rtos (+ num (atof (setq oldvalue (substr 
	(setq str (vlax-get-property ent 'TextString))
	(+ 2 (vl-string-position (ascii "-") str)) 
)))) 2 (- (- (strlen oldvalue) (vl-string-position (ascii ".") oldvalue)) 1)))
oldvalue
str
))
(vlax-put-property ent 'TextString kq))
)
(vl-load-com)

[pdle 126]

1. Lisp này thì có ngoặc hay không, vẫn chạy tốt

2. Em đã phá tan tành cái lisp của anh ketxu rồi :P

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43745&st=0&gopid=149909entry149909
(defun c:++(/ num kq oldvalue str dng ddt)
(setq num (getreal "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq dng (vl-string-position (ascii ")") (setq str (vlax-get-property ent 'TextString)))) 
(if (= dng nil) (setq dng (strlen str)))
(setq kq (vl-string-subst 
(strcat " " (rtos (+ num (atof (setq oldvalue (substr str
	(+ 2 (setq ddt (vl-string-position (ascii "-") str))) (- dng ddt 1)))))
 2 (- (strlen oldvalue) (cond ((vl-string-position (ascii ".") oldvalue)) (T (1- (strlen oldvalue))))  1)))
oldvalue
str
))

(vlax-put-property ent 'TextString kq)))
(vl-load-com)

[ketxu 2.984]

1. Lisp này thì có ngoặc hay không, vẫn chạy tốt

2. Em đã phá tan tành cái lisp của anh ketxu rồi :P

Tan cũng được, miễn là nó đúng với yêu cầu đề ra, vì 1 việc có thể đi nhiều con đường mà :)

Cảm ơn pdle ^^

@Tinya : bạn không nên mở nhiều topic vì 1 vấn đề.Lần này mình gộp lại.Lần sau nếu làm thế mình sẽ tick cảnh cáo nhé :angry:

Cũng xin nhận lỗi với bạn vì topic đó mình không theo dõi thưỡng xuyên được, nên không biết bạn có vướng mắc

[tinya1225 36]

1. Lisp này thì có ngoặc hay không, vẫn chạy tốt

2. Em đã phá tan tành cái lisp của anh ketxu rồi :P

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=43745&st=0&gopid=149909entry149909
(defun c:++(/ num kq oldvalue str dng ddt)
(setq num (getreal "\nS\U+1ED1 c\U+1EA7n c\U+1ED9ng th\U+00EAm :"))
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
(setq dng (vl-string-position (ascii ")") (setq str (vlax-get-property ent 'TextString)))) 
(if (= dng nil) (setq dng (strlen str)))
(setq kq (vl-string-subst 
(strcat " " (rtos (+ num (atof (setq oldvalue (substr str
	(+ 2 (setq ddt (vl-string-position (ascii "-") str))) (- dng ddt 1)))))
 2 (- (strlen oldvalue) (cond ((vl-string-position (ascii ".") oldvalue)) (T (1- (strlen oldvalue))))  1)))
oldvalue
str
))

(vlax-put-property ent 'TextString kq)))
(vl-load-com)

Cám ơn bạn nhiều nhé. Thanks + bạn rùi đó ^^.

@Ketxu bác ơi vì hôm trc bác nói ko thích string lắm, em đợi mấy hôm ko thấy bác reply nên mới viết thêm, mà bài cũ chẳng biết viết thêm vào cái j nên mới lập thêm 2pic. lần sau e sẽ chú ý hơn :rolleyes:

Mà bác bảo nhận lỗi với e sao ko cho em cái thanks + coi như tạ lỗi nhỉ :lol:

Chúc cả nhà 1 ngày vui vẻ :))

[bienda 4]

Tan cũng được, miễn là nó đúng với yêu cầu đề ra, vì 1 việc có thể đi nhiều con đường mà

Cảm ơn pdle ^^

@Tinya : bạn không nên mở nhiều topic vì 1 vấn đề.Lần này mình gộp lại.Lần sau nếu làm thế mình sẽ tick cảnh cáo nhé :angry:

Cũng xin nhận lỗi với bạn vì topic đó mình không theo dõi thưỡng xuyên được, nên không biết bạn có vướng mắc

 

 

Giả sự text của tôi có dạng xxxxyyyy (trong đó X là chữ, còn y là số, ví dụ: ABC123) thì lisp này phải sửa thế nào?

Mong các bác chỉ giúp

[Doan Van Ha 3.186]

 

 

Giả sự text của tôi có dạng xxxxyyyy (trong đó X là chữ, còn y là số, ví dụ: ABC123) thì lisp này phải sửa thế nào?

Mong các bác chỉ giúp

Đây là Text có tiền tố. Bạn muốn sửa từ lsp của ai nào, ở # ?

P/S: srr, có Ket thì để Ket sửa, tội gì! Hihihi.

[ketxu 2.984]

 

 

Giả sự text của tôi có dạng xxxxyyyy (trong đó X là chữ, còn y là số, ví dụ: ABC123) thì lisp này phải sửa thế nào?

Mong các bác chỉ giúp

Bạn miêu tả lại Yêu cầu của mình và chính xác định dạng là như thế nào ?

[bienda 4]

Bạn miêu tả lại Yêu cầu của mình và chính xác định dạng là như thế nào ?

 

vẫn chỉ như bài viết này thôi

Text của bác trên có dạng ABC-123

Nhưng text của em chỉ là ABC123

thì sửa lisp của bác như thế nào

Cảm ơn bác đã trả lời em

[ketxu 2.984]

 

vẫn chỉ như bài viết này thôi

Text của bác trên có dạng ABC-123

Nhưng text của em chỉ là ABC123

thì sửa lisp của bác như thế nào

Cảm ơn bác đã trả lời em

 

 

(defun c:++(/)
(setq  ss (ssget (list (cons 0 "TEXT,MTEXT"))) ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
 int (getint "\nSo can cong them :"))
(vlax-for ent ss
(vla-put-textstring
 ent
 (strcat
  (setq str
(vl-list->string
	(vl-remove-if-not '(lambda(x) (or (< x 48) (> x 57)))
	(vl-string->list (setq fStr (vla-get-textstring ent))))
)
  )
  (vl-princ-to-string (+ int(atoi (vl-string-left-trim str fStr) )))
 )
)
)
)

[Doan Van Ha 3.186]

 

vẫn chỉ như bài viết này thôi

Text của bác trên có dạng ABC-123

Nhưng text của em chỉ là ABC123

thì sửa lisp của bác như thế nào

Cảm ơn bác đã trả lời em

@Ketxu: không thấy Ket giúp nên nghĩ chắc Ket bận, đành liều giúp vậy, có gì thì srr nhé!

Bạn dùng cái này thì Text có các kiểu tiền tố và hậu tố hay số nguyên và số thực đều OK

P/S: loay hoay viết, đến khi xong, thì Ket đã xong rồi, srr Ket.

(defun C:HA( / num txtm)	;Doan Van Ha CADViet.com
(setq num (getreal "\nNhap so can them/bot: "))
(princ "\nChon cac Text can thay doi...")
(foreach ent (acet-ss-to-list (ssget '((0 . "*TEXT"))))
 (setq txtm (acet-str-replace (cadr (chia3 (cdr (assoc 1 (entget ent)))))
                                      			(rtos (+ num (atof (cadr (chia3 (cdr (assoc 1 (entget ent))))))) 2 (get-sle (cadr (chia3 (cdr (assoc 1 (entget ent)))))))
                                      			(cdr (assoc 1 (entget ent)))))
 (entmod (subst (cons 1 txtm) (cons 1 (cdr (assoc 1 (entget ent)))) (entget ent)))))
(defun get-sle (str)
(if (not (acet-str-find "." str)) 0 (- (strlen str) (acet-str-find "." str))))
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
 (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
			(T (setq lstt nil))))
(while lstn
 (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
			(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))

[bienda 4]

 

 

 

Sau khi mình chọn đối tượng thì command chẳng thông báo gì cả

[ketxu 2.984]

Quên mất, bạn thêm dòng này vào đầu lisp hộ mình (vl-load-com), dòng này ở sẵn trong máy mình nên nhiều lúc quên

[bienda 4]

@Ketxu: không thấy Ket giúp nên nghĩ chắc Ket bận, đành liều giúp vậy, có gì thì srr nhé!

Bạn dùng cái này thì Text có các kiểu tiền tố và hậu tố hay số nguyên và số thực đều OK

P/S: loay hoay viết, đến khi xong, thì Ket đã xong rồi, srr Ket.

(defun C:HA( / num txtm)	;Doan Van Ha CADViet.com
(setq num (getreal "\nNhap so can them/bot: "))
(princ "\nChon cac Text can thay doi...")
(foreach ent (acet-ss-to-list (ssget '((0 . "*TEXT"))))
 (setq txtm (acet-str-replace (cadr (chia3 (cdr (assoc 1 (entget ent)))))
                                  				(rtos (+ num (atof (cadr (chia3 (cdr (assoc 1 (entget ent))))))) 2 (get-sle (cadr (chia3 (cdr (assoc 1 (entget ent)))))))
                                  				(cdr (assoc 1 (entget ent)))))
 (entmod (subst (cons 1 txtm) (cons 1 (cdr (assoc 1 (entget ent)))) (entget ent)))))
(defun get-sle (str)
(if (not (acet-str-find "." str)) 0 (- (strlen str) (acet-str-find "." str))))
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))
(while lstt
 (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
		(T (setq lstt nil))))
(while lstn
 (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
		(T (setq lstn nil))))
(setq ds (list (vl-list->string (reverse trai))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                   	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))

Rất cảm ơn sự giúp đỡ của bạn

Thanks 2 người sao lại không được nhỉ

Diễn đàn bảo lỗi