Chuyển đến nội dung
Diễn đàn CADViet
Han Tinh

Lisp Đóng Mở Ngoặc Text, Mtext, Dim

Bởi Han Tinh , trong AutoLisp

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

Han Tinh    7

Han Tinh
Đã đăng

Chào các bạn trên diễn đàn cadviet.com, mình có sưu tầm được 1 lsp dùng để đóng mở ngoặc của text của bạn ketxu. Bây giờ mình muốn mọi người giúp mình sữa lại sao cho khi ta goi lệnh và chọn vào đối tượng thì đối tượng đươc đóng ngoặc, chọn đối tượng lần nữa thì bỏ đóng ngoặc(lsp đang dùng thì mỗi lần chọn thì nó cứ đóng ngoặc). Và lsp thì chọn đối tượng text là tiếng việt thì bị lỗi font. Mong mọi người giúp đỡ.

(defun c:fg(/ s sd)
(vl-load-com)
(ssget '((0 . "*TEXT,*DIMENSION")))
(vlax-for o (setq s(vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
	(cond 
		(	(wcmatch (vla-get-ObjectName o) "*Text")
			(vla-put-Textstring o (strcat "(" (vla-get-Textstring o) ")"))
		)
		((vla-put-TextOverride o
			(strcat
"("
					(if (/= (setq sd (vla-get-TextOverride o)) "") sd "<>")
")"
			)
		))			
	)
)
(and s (vla-delete s))
)
 

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

quocmanh04tt
Đã đăng

Bạn dùng Lisp này cho Text và Mtext:

(defun c:tt  (/ els pos ss str)
 (and (setq ss (ssget '((0 . "*TEXT"))))
      (foreach x  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq els (entget x))
       (setq str (cdr (assoc 1 els)))
       (if (vl-string-search (chr 40) (strcase str))
        (while (setq pos (vl-string-search (chr 40) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat (chr 40) str)))
       (entmod (subst (cons 1 str) (assoc 1 els) els))
       (if (vl-string-search (chr 41) (strcase str))
        (while (setq pos (vl-string-search (chr 41) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat str (chr 41))))
       (entmod (subst (cons 1 str) (assoc 1 els) els))))
 (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

Tue_NV    3.912

Tue_NV
Đã đăng

Bạn thử Lisp này: 

 

(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
  (setq i 0)
  (mapcar 'set '(find rep str icase) Lst)
  (while (setq i (vl-string-search (if icase (strcase find) find)
  (if icase (strcase str) str) i))
    (if icase
(setq str (vl-string-subst (strcase find) find str i)
  str (vl-string-subst rep (strcase find) str i))
        (setq str (vl-string-subst rep find str i))
    )
    (setq i (+ i (strlen rep) ) ) )
str)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
  (setq entget-ename (entget ename))
  (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
(setq entget-ename (append entget-ename (list (cons dxf newValue))))
  )
  (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
  (entmod entget-ename)
  ename
)
(defun c:md()
  (if (setq ss (ssget '((0 . "*TEXT,*DIMENSION")))) (progn
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (if (and (wcmatch (setq nd (cdr(assoc 1 (entget e)))) "*(*")
    (wcmatch nd "*)*")
)
      (Tue-ent-mod 1 e (Tue-string-replace (list ")" "" (Tue-string-replace (list "(" "" nd)))))
      (Tue-ent-mod 1 e (strcat "(" nd ")"))
     )
   )
 ))
)
  • Like 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

conankid    4

conankid
Đã đăng

Bạn dùng Lisp này cho Text và Mtext:

(defun c:tt  (/ els pos ss str)
 (and (setq ss (ssget '((0 . "*TEXT"))))
      (foreach x  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq els (entget x))
       (setq str (cdr (assoc 1 els)))
       (if (vl-string-search (chr 40) (strcase str))
        (while (setq pos (vl-string-search (chr 40) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat (chr 40) str)))
       (entmod (subst (cons 1 str) (assoc 1 els) els))
       (if (vl-string-search (chr 41) (strcase str))
        (while (setq pos (vl-string-search (chr 41) (strcase str)))
         (setq str (strcat (substr str 1 pos) (substr str (+ 2 pos)))))
        (setq str (strcat str (chr 41))))
       (entmod (subst (cons 1 str) (assoc 1 els) els))))
 (princ))

Cho mình hỏi lisp này dùng như thế nào vậy bạn?cảm ơn nhiều!

  • 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

Han Tinh    7

Han Tinh
Đã đăng

 

Bạn thử Lisp này: 

(vl-load-com)
(defun Tue-string-replace (Lst / i find rep str icase)
;;;;;write by Tue_NV
  (setq i 0)
  (mapcar 'set '(find rep str icase) Lst)
  (while (setq i (vl-string-search (if icase (strcase find) find)
  (if icase (strcase str) str) i))
    (if icase
(setq str (vl-string-subst (strcase find) find str i)
  str (vl-string-subst rep (strcase find) str i))
        (setq str (vl-string-subst rep find str i))
    )
    (setq i (+ i (strlen rep) ) ) )
str)
(defun Tue-ent-mod (dxf ename newValue / entget-ename)
  (setq entget-ename (entget ename))
  (if (and (or (= dxf 62) (= dxf 6)) (null (assoc dxf entget-ename)))
(setq entget-ename (append entget-ename (list (cons dxf newValue))))
  )
  (setq entget-ename (subst (cons dxf newValue) (assoc dxf entget-ename) entget-ename))
  (entmod entget-ename)
  ename
)
(defun c:md()
  (if (setq ss (ssget '((0 . "*TEXT,*DIMENSION")))) (progn
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (if (and (wcmatch (setq nd (cdr(assoc 1 (entget e)))) "*(*")
    (wcmatch nd "*)*")
)
      (Tue-ent-mod 1 e (Tue-string-replace (list ")" "" (Tue-string-replace (list "(" "" nd)))))
      (Tue-ent-mod 1 e (strcat "(" nd ")"))
     )
   )
 ))
)

Hai lsp của bạn và rất đúng với ý mình rồi, nhưng 2 lso này chưa chọn được đối tượng là dim. Mong hai bạn giúp thêm

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

quocmanh04tt
Đã đăng

Cái này áp dụng cho cả Dim và *TEXT

(vl-load-com)(defun c:tt (/ repentmod els ss str)

(defun repentmod (cha text_str lst flag / pos dim_dec)

(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))

(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))

text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))

(if (vl-string-search cha (strcase text_str))

(while (setq pos (vl-string-search cha (strcase text_str)))

(setq text_str (strcat (substr text_str 1 pos) (substr text_str (+ 2 pos)))))

(cond ((eq flag 1) (setq text_str (strcat cha text_str)))

((eq flag 0) (setq text_str (strcat text_str cha)))))

(entmod (subst (cons 1 text_str) (assoc 1 lst) lst)))

(and (setq ss (ssget '((0 . "*TEXT,*DIMENSION"))))

(mapcar '(lambda (x) (repentmod (chr 40) (cdr (assoc 1 (entget x))) (entget x) 1))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(mapcar '(lambda (x) (repentmod (chr 41) (cdr (assoc 1 (entget x))) (entget x) 0))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))

(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

Tue_NV    3.912

Tue_NV
Đã đăng

Hai lsp của bạn và rất đúng với ý mình rồi, nhưng 2 lso này chưa chọn được đối tượng là dim. Mong hai bạn giúp thêm

Lisp mình viết chọn cả dim rồi mà!

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

Han Tinh    7

Han Tinh
Đã đăng

Cái này áp dụng cho cả Dim và *TEXT

(vl-load-com)(defun c:tt (/ repentmod els ss str)

(defun repentmod (cha text_str lst flag / pos dim_dec)

(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))

(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))

text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))

(if (vl-string-search cha (strcase text_str))

(while (setq pos (vl-string-search cha (strcase text_str)))

(setq text_str (strcat (substr text_str 1 pos) (substr text_str (+ 2 pos)))))

(cond ((eq flag 1) (setq text_str (strcat cha text_str)))

((eq flag 0) (setq text_str (strcat text_str cha)))))

(entmod (subst (cons 1 text_str) (assoc 1 lst) lst)))

(and (setq ss (ssget '((0 . "*TEXT,*DIMENSION"))))

(mapcar '(lambda (x) (repentmod (chr 40) (cdr (assoc 1 (entget x))) (entget x) 1))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(mapcar '(lambda (x) (repentmod (chr 41) (cdr (assoc 1 (entget x))) (entget x) 0))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))

(princ))

Thanks bạn quocmanh04tt nhiều! Lsp này áp dụng cho cv của mình quá ok. 

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

conankid    4

conankid
Đã đăng

Cái này áp dụng cho cả Dim và *TEXT

(vl-load-com)(defun c:tt (/ repentmod els ss str)

(defun repentmod (cha text_str lst flag / pos dim_dec)

(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))

(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))

text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))

(if (vl-string-search cha (strcase text_str))

(while (setq pos (vl-string-search cha (strcase text_str)))

(setq text_str (strcat (substr text_str 1 pos) (substr text_str (+ 2 pos)))))

(cond ((eq flag 1) (setq text_str (strcat cha text_str)))

((eq flag 0) (setq text_str (strcat text_str cha)))))

(entmod (subst (cons 1 text_str) (assoc 1 lst) lst)))

(and (setq ss (ssget '((0 . "*TEXT,*DIMENSION"))))

(mapcar '(lambda (x) (repentmod (chr 40) (cdr (assoc 1 (entget x))) (entget x) 1))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(mapcar '(lambda (x) (repentmod (chr 41) (cdr (assoc 1 (entget x))) (entget x) 0))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))

(princ))

Cái này mình xài đc nè.cảm ơn bạn quocmanh04tt nhiều nha!

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

Funiki28    1

Funiki28
Đã đăng
Vào lúc 30/7/2016 tại 16:48, quocmanh04tt đã nói:

Cái này áp dụng cho cả Dim và *TEXT

  


(vl-load-com)(defun c:tt (/ repentmod els ss str)

(defun repentmod (cha text_str lst flag / pos dim_dec)

(if (and (wcmatch (cdr (assoc 0 lst)) "*DIMENSION") (eq text_str (chr 0)))

(setq dim_dec (cdr (assoc 271 (tblsearch "DIMSTYLE" (cdr (assoc 3 lst)))))

text_str (rtos (cdr (assoc 42 lst)) 2 dim_dec)))

(if (vl-string-search cha (strcase text_str))

(while (setq pos (vl-string-search cha (strcase text_str)))

(setq text_str (strcat (substr text_str 1 pos) (substr text_str (+ 2 pos)))))

(cond ((eq flag 1) (setq text_str (strcat cha text_str)))

((eq flag 0) (setq text_str (strcat text_str cha)))))

(entmod (subst (cons 1 text_str) (assoc 1 lst) lst)))

(and (setq ss (ssget '((0 . "*TEXT,*DIMENSION"))))

(mapcar '(lambda (x) (repentmod (chr 40) (cdr (assoc 1 (entget x))) (entget x) 1))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(mapcar '(lambda (x) (repentmod (chr 41) (cdr (assoc 1 (entget x))) (entget x) 0))

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))

(princ))

Mình sử dụng lisp của bạn đáp ứng rất đúng yêu cầu của chủ thớt, tuy nhiên mình nghĩ lisp nên chỉ áp dụng cho text và mtext thôi.

Mình dùng mechanical 2012 và có hiện tượng này. Khi dùng lisp với dim, nó sẽ lấy giá trị dim hiện hành và nhớ giá trị đó. Sau đó nó sẽ sửa như ta đánh lại kích thước thêm ngoặc vậy. Điều này theo mình khá nguy hiểm, nếu sau này chủ thớt stretch đối tượng đi thì kích thước sẽ ko đc thay đổi nữa mà giữ nguyên kích thước cũ, khả năng làm sai rất cao. Mình góp ý như vậy :p. Nếu khắc phục đc điều này mình nghĩ lisp sẽ rất tuyệt :p

 

image.thumb.png.4012d3a2d27fa4846563e52111f144fb.png

image.thumb.png.24de9eee3115f56aac9d2f0fb74fcb66.png

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
Về Đầu Trang AutoLisp
×