Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 Han Tinh

Han Tinh

    biết vẽ pline

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

Đã gửi 30 July 2016 - 06:23 AM

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

  • 0

#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 30 July 2016 - 07:17 AM

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

  • 0

#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 July 2016 - 07:25 AM

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

  • 0

#4 conankid

conankid

    biết vẽ rectang

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

Đã gửi 30 July 2016 - 08:10 AM

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!


  • -1

Chẳng biết ngày mai có ra sao

Mà có ra sao cũng chẳng sao.


#5 conankid

conankid

    biết vẽ rectang

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

Đã gửi 30 July 2016 - 08:23 AM

152704_capture_8.png

Cái này em load xong rồi.gõ lênh tt mà sao vẫn không đc nhỉ? hix 152704_capture1.png


  • 0

Chẳng biết ngày mai có ra sao

Mà có ra sao cũng chẳng sao.


#6 conankid

conankid

    biết vẽ rectang

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

Đã gửi 30 July 2016 - 08:27 AM

152704_untitled.png


  • 0

Chẳng biết ngày mai có ra sao

Mà có ra sao cũng chẳng sao.


#7 Han Tinh

Han Tinh

    biết vẽ pline

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

Đã gửi 30 July 2016 - 02:01 PM

 

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


  • 0

#8 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 30 July 2016 - 04:48 PM

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

  • 0

#9 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 July 2016 - 05:51 PM

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à!


  • 0

#10 Han Tinh

Han Tinh

    biết vẽ pline

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

Đã gửi 30 July 2016 - 05:51 PM

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. 


  • 0

#11 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 30 July 2016 - 06:35 PM

@Bác Tuệ: Nếu textdim chưa bị sửa (override) thì DXF1 của nó là "".


  • 0

#12 conankid

conankid

    biết vẽ rectang

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

Đã gửi 01 August 2016 - 08:56 AM

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!


  • 0

Chẳng biết ngày mai có ra sao

Mà có ra sao cũng chẳng sao.