Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Han Tinh

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

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

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

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

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

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

 

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

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

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

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

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

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  

×