Chuyển đến nội dung
Diễn đàn CADViet
Luu Nguyen

Đóng Ngoặc Text, Mtext, Dim

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



(Defun c:FG (/ c e ss txt cmde ttdangs ttdangt)

  (setq cmde (getvar "CMDECHO"))

  (setvar "CMDECHO" 0)

  (setq ttdangt (getstring 5"\nChuoi muon them phia truoc:")) 

  (setq ttdangs (getstring 5"\nChuoi muon them phia sau:")) 

  (if (null ttdangt)(setq ttdangt ""))

  (if (null ttdangs)(setq ttdangs ""))

 (prompt "\nChon chu muon chinh.")

  (setq ss (ssget))

  (setq c 0)

  (if ss (setq e (ssname ss c)))

  (while e

    (setq e (entget e))

    ; Ensure entity is text

    (if (= (cdr (assoc 0 e)) "TEXT")

        (progn

                 (setq txt (strcat ttdangt (cdr (assoc 1 e)) ttdangs))

           (setq e (subst (cons 1 txt) (assoc 1 e) e))

           (entmod e)

        )

    )

    (setq c (1+ c)) ; Increment counter.

    (setq e (ssname ss c))  ; Obtain next entity.

   )

   (setvar "CMDECHO" cmde)

      (PrinC)

)

 

  • 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

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 ngoặc text(), nhưng phải thực hiện đến 3 bước mới xong chức năng này(phải nhập tiền tố, hậu tố rồi mới chọn đối tượng). Bây giờ mình nhờ mọi người trên diễn đàn ai biết giúp mình với, mình xin cảm ơn trước:
Khi gõ lệnh FG sau đó chọn đối tượng thì đối tượng sẽ được đóng ngoặc().


(Defun c:FG (/ c e ss txt cmde ttdangs ttdangt)
  (setq cmde (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq ttdangt (getstring 5"\nChuoi muon them phia truoc:")) 
  (setq ttdangs (getstring 5"\nChuoi muon them phia sau:")) 
  (if (null ttdangt)(setq ttdangt ""))
  (if (null ttdangs)(setq ttdangs ""))
 (prompt "\nChon chu muon chinh.")
  (setq ss (ssget))
  (setq c 0)
  (if ss (setq e (ssname ss c)))
  (while e
    (setq e (entget e))
    ; Ensure entity is text
    (if (= (cdr (assoc 0 e)) "TEXT")
        (progn
                 (setq txt (strcat ttdangt (cdr (assoc 1 e)) ttdangs))
           (setq e (subst (cons 1 txt) (assoc 1 e) e))
           (entmod e)
        )
    )
    (setq c (1+ c)) ; Increment counter.
    (setq e (ssname ss c))  ; Obtain next entity.
   )
   (setvar "CMDECHO" cmde)
      (PrinC)
)

  • Vote giảm 2

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

(defun c:fg(/ s)
(vl-load-com)
(ssget '((0 . "*TEXT")))
(vlax-for o (setq s(vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
(vla-put-Textstring o (strcat "(" (vla-get-Textstring o) ")"))
)
(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

Giờ mình mới nhìn thấy chữ Dim trên tiêu đề ??? Có lẽ vài ngày trước mắt mình hoa ^^
Nhưng cái lisp bạn đưa k dính dáng gì đến dimension cả, k hiểu trước đây là làm ntn.
CHo mình hỏi các Dimension của bạn là Dim có giá trị đơn thuần (k edit) hay có các ký tự khác mà bạn đã viết ... Bởi có vài trường hợp bạn k cần lisp

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ử cái này xem sao . chú ý trong LISP co đoạn cho phép chỉnh sửa dấu ngoặc bạn có thể thay đổi tuỳ ý (trong mặc định đang là 1) bạn thay số này bằng số 2,3,... sẽ thấy sự thay đổi khi chọn đối tượng

 

 


(defun c:fg (/ ss checkstring SoluongNgoac obj)
(defun checkstring (str N / loc_lst lst r l1 l2 str1 str2)
(setq lst (vl-string->list str)
l1 lst
str1 "" str2 "")
(defun loc_lst (i r / r2)
(setq r2 r)
(while (= (car(member i r2)) i) (setq r2 (cdr(member i r2))))
r2)
(setq r (loc_lst 40 l1)
r (loc_lst 41 (reverse r))
r (reverse r))
(repeat N (setq str1 (strcat str1 "(" )))
(repeat N (setq str2 (strcat str2 ")" )))
(strcat str1 (vl-list->string r) str2)
)

;;;Chinh sua so luong BO Dau Ngoac o day
(setq SoluongNgoac 1)

; (setq obj (vlax-ename->vla-object (car(entsel))))
(if (setq ss (ssget '((0 . "*DIM*,*TEXT"))))
(progn
(vlax-for obj (vla-get-activeselectionset(vla-get-activedocument(vlax-get-acad-object)))
(cond
((wcmatch (vla-get-objectname obj) "*Text*")
(vla-put-textstring obj (checkstring (vla-get-textstring obj) SoluongNgoac)))
((wcmatch (vla-get-objectname obj) "*Dim*")
(if (= (vla-get-textoverride obj) "")
(vla-put-textoverride obj (checkstring(rtos (vla-get-measurement obj)) SoluongNgoac))
(vla-put-textoverride obj (checkstring(vla-get-textoverride obj) SoluongNgoac))
)
)))
)
)
(princ)
)


  • Vote tăng 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

Quick code :

(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))
)
  • Vote tăng 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

Em cũng tham gia với các bác 1 cái (thuần lisp):

 

(defun c:fg  (/ els i ss str)
 (if (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
  (repeat (setq i (sslength ss))
   (setq els (entget (ssname ss (setq i (1- i))))
         str (cdr (assoc 1 els)))
   (if (eq (cdr (assoc 0 els)) "DIMENSION")
    (or (not (eq (setq str (cdr (assoc 1 els))) "")) (setq str (rtos (cdr (assoc 42 els))))))
   (setq els (subst (cons 1 (strcat "(" str ")")) (assoc 1 els) els))
   (entmod els)))
 (princ))
  • Vote tăng 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

Quick code :

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

 

 

Cảm ơn bạn ketxu nhiều lắm! Lsp của bạn viết đúng ý mình rồi.

Cảm ơn bạn quansla

Cảm ơn bạn quocmanh04tt

Mỗi người có ưu điểm riêng.

  • Vote tăng 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

Trong trường hợp này mình sữa dòng (if (= enttxt "TEXT")

 thành dòng (if (= enttxt "*TEXT, *DIMENSION") sao không chon được mtext và dim vậy các bạn(đầu tiên thì chọn được TEXT rồi)? Các bạn sữa hộ giúp mình lsp này với.

;;;*************************DAU PHI***************************
(defun c:ff ()
    (setvar "cmdecho" 0)
    (setq olderr *error* *error* myerror)
    (prompt "\nHay chon dong TEXT !... ")
    (prompt "\nSelect objects: ")
    (command "select" "au" pause)
    (setq sstxt (ssget "p")
          sslen (sslength sstxt)
          ctr 0
    )
    (command ".undo" "mark")
    (while (< ctr sslen)
           (setq listxt (entget (ssname sstxt ctr))
                 txttxt (cdr (assoc 1 listxt))
                 enttxt (cdr (assoc 0 listxt))
           )
           (if (= enttxt "TEXT")
               (progn
                   (setq testxt (substr txttxt 1 3))
                   (if (or (= testxt "%%C") (= testxt "%%C"))
                       (setq newtxt (substr txttxt 4))
                       (setq newtxt (strcat "%%C" txttxt))
                   )
                   (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
                   (entmod listxt)
                )
            )
            (setq ctr (1+ ctr))
    )
    (setq *error* olderr)
    (setvar "cmdecho" 1)
    (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

Nếu sửa như thế thì phải thay hàm = thành hàm wcmatch

Nếu vậy thì mình thay dấu bằng = thành wcmatch hay sao bạn Doan Van Ha?(mình làm như vậy nhưng không được rồi). Mong bạn giúp thêm

  • 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

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


×