Không Thống Kê Được Text Và Mtext Có Font Tiếng Việt

[Kieu Tan 22]

Mình có 1 lsp dùng để thống kê TEXT VÀ MTEXT nhưng nó chỉ thống kê được TEXT VÀ MTEXT không có dấu, nếu font có dấu thì sau khi thống kê nó bị lỗi font(font tiếng việt bị lỗi font). Mong mọi người giúp đỡ. Thanks các bạn! 

(defun c:tkt  (/ lst msp pt ss str txtsiz-0 txtsiz doc)
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*TEXT"))))
    (progn (foreach e  (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
             (setq str      (vla-get-TextString e)
                   txtsiz-0 (vla-get-height e))
             (if (not (assoc str lst))
               (setq lst (cons (cons str 1) lst))
               (setq lst (subst (cons str (1+ (cdr (assoc str lst)))) (assoc str lst) lst))))
           (or (setq txtsiz (getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos txtsiz-0 2 2) ">: ")))
               (setq txtsiz txtsiz-0))
           (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))
                 pt  (getpoint "\nDiem dat Bang :")
                 doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
                 msp (if (zerop (vla-get-activespace doc))
                       (if (= (vla-get-mspace doc) :vlax-true)
                         (vla-get-modelspace doc)
                         (vla-get-paperspace doc))
                       (vla-get-modelspace doc)))
           (foreach e  lst
             (vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz)
             (vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz)
             (setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))))
    (alert "Khong chon duoc Text."))
  (princ))​

[Kieu Tan 22]

Giúp mình với mọi người ơi!

[tien2005 242]

đổi về font vni hay tcvn3 rồi thống kê

[Kieu Tan 22]

đổi về font vni hay tcvn3 rồi thống kê

Cái này ví dụ là:

ta có 1 dãy danh sách *text vừa có dấu và không có dấu, bây giờ ta muốn thống kê nó ra bao nhiêu loại thôi

Nếu 1 dãy danh sách này ở font gì thì lsp thống kê cho ra font đó. 

[quocmanh04tt 635]

Các bác ngại viết ấy mà, thử viết lại cho chủ top cái, không biết có ổn không đây!???

(defun c:tt (/ make-Text hei lst pt ss str sty)

(defun make-Text (pt hgt str sty)

(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

(and (vl-load-com)

(princ "\nQuet chon Text, Mtext de thong ke...!")

(setq ss (ssget (list (cons 0 "*TEXT"))))

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

(setq str (cdr (assoc 1 (entget e)))

hei (cdr (assoc 40 (entget e))))

(if (not (assoc str lst))

(setq lst (cons (cons str (list (cons 1 e))) lst))

(setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

(setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

(hei)))

(setq pt (getpoint "\nDiem dat Bang: "))

(foreach e (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

(make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

(make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

(setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

(princ))

[Kieu Tan 22]

Các bác ngại viết ấy mà, thử viết lại cho chủ top cái, không biết có ổn không đây!???

(defun c:tt (/ make-Text hei lst pt ss str sty)

(defun make-Text (pt hgt str sty)

(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

(and (vl-load-com)

(princ "\nQuet chon Text, Mtext de thong ke...!")

(setq ss (ssget (list (cons 0 "*TEXT"))))

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

(setq str (cdr (assoc 1 (entget e)))

hei (cdr (assoc 40 (entget e))))

(if (not (assoc str lst))

(setq lst (cons (cons str (list (cons 1 e))) lst))

(setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

(setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

(hei)))

(setq pt (getpoint "\nDiem dat Bang: "))

(foreach e (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

(make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

(make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

(setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

(princ))

Bạn quocmanh04tt  ơi ! 

Đối với text thì ok rồi

nhưng sao đối với mtext thì có lúc được lúc không

Mình có gởi file đính kèm để bạn xem thử nha ! 

http://www.cadviet.com/upfiles/6/145520_tkt_1.dwg

[Doan Van Ha 3.196]

Tôi đã nói ở trên rồi nhưng bạn quocmanh04tt  đã viết lisp nên phải xóa bài. Xuất text tiếng Việt (thường là bị sửa font) không đơn giản. LM có lisp về nó đấy.

[quocmanh04tt 635]

Trường hợp này đã nghĩ đến rồi, nhưng hôm qua vội chưa kịp đưa vào, sẽ nghiên cứu bổ sung.

@bác Hạ, chú đã từng áp dụng cái của LM để làm 1 lsp khác riêng cho mình rồi.

[Kieu Tan 22]

Trường hợp này đã nghĩ đến rồi, nhưng hôm qua vội chưa kịp đưa vào, sẽ nghiên cứu bổ sung.

@bác Hạ, chú đã từng áp dụng cái của LM để làm 1 lsp khác riêng cho mình rồi.

Mong tin bác! 

[quocmanh04tt 635]

@Chủ top! giải quyết tạm theo cách sau:

Bước 1: copy lsp ở dưới paste vào lsp trên, đầu hay cuối lsp đều được.

Bước 2: Thay đoạn này (trong lsp trên): (cdr (assoc 1 (entget e))) bởi: (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

​Nếu có lỗi khác thì post lên!

(defun LM:UnFormat (str mtx / _replace rx)

(defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))

(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))

(progn (setq str (vl-catch-all-apply

(function

(lambda ()

(vlax-put-property rx 'global actrue)

(vlax-put-property rx 'multiline actrue)

(vlax-put-property rx 'ignorecase acfalse)

(foreach pair '(("\032" . "\\\\\\\\")

(" " . "\\\\P|\\n|\\t")

("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")

("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")

("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")

("$1" . "[\\\\]({)|{"))

(setq str (_replace (car pair) (cdr pair) str)))

(if mtx

(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))

(_replace "\\" "\032" str))))))

(vlax-release-object rx)

(if (null (vl-catch-all-error-p str))

str))))

[Kieu Tan 22]

@Chủ top! giải quyết tạm theo cách sau:

Bước 1: copy lsp ở dưới paste vào lsp trên, đầu hay cuối lsp đều được.

Bước 2: Thay đoạn này (trong lsp trên): (cdr (assoc 1 (entget e))) bởi: (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

​Nếu có lỗi khác thì post lên!

(defun LM:UnFormat (str mtx / _replace rx)

(defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))

(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))

(progn (setq str (vl-catch-all-apply

(function

(lambda ()

(vlax-put-property rx 'global actrue)

(vlax-put-property rx 'multiline actrue)

(vlax-put-property rx 'ignorecase acfalse)

(foreach pair '(("\032" . "\\\\\\\\")

(" " . "\\\\P|\\n|\\t")

("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")

("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")

("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")

("$1" . "[\\\\]({)|{"))

(setq str (_replace (car pair) (cdr pair) str)))

(if mtx

(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))

(_replace "\\" "\032" str))))))

(vlax-release-object rx)

(if (null (vl-catch-all-error-p str))

str))))

Đã tải về và làm theo hướng dẫn của bạn, nhưng sau khi chọn đối tượng rồi enter thì nó xuất hiện bảng sau :

[quocmanh04tt 635]

Bắt bệnh và hướng giải quyết:

1. Làm chưa đúng theo hướng dẫn (kiểm tra dấu đóng mở () cho đầy đủ, chính xác).

2. Hoặc: Ở lsp thứ 2, copy đừng download vì nó có nhiều ký tự đặc biệt, loằng ngoằng, do chức năng của diễn đàn dễ dẫn đến lỗi lsp.

3. Nếu làm 2 việc ở trên vẫn không xong thì post cái không xong lên đây.

[Kieu Tan 22]

Bắt bệnh và hướng giải quyết:

1. Làm chưa đúng theo hướng dẫn (kiểm tra dấu đóng mở () cho đầy đủ, chính xác).

2. Hoặc: Ở lsp thứ 2, copy đừng download vì nó có nhiều ký tự đặc biệt, loằng ngoằng, do chức năng của diễn đàn dễ dẫn đến lỗi lsp.

3. Nếu làm 2 việc ở trên vẫn không xong thì post cái không xong lên đây.

Đã làm theo hướng dẫn của bạn, nhưng:

[quocmanh04tt 635]

Thử tải cái này về chạy thử xem sao (lệnh TKT):

http://www.cadviet.com/upfiles/6/141736_tkt.rar

[Kieu Tan 22]

Thử tải cái này về chạy thử xem sao (lệnh TKT):

http://www.cadviet.com/upfiles/6/141736_tkt.rar

Tuyệt vời rồi bạn quocmanh04tt ơi !

Thật vất vã cho bạn quá !

Cảm ơn bạn nhiều lắm ! 

[quocmanh04tt 635]

Vậy là làm không đúng theo hướng dẫn, file ở trên chỉ chuyển sang fas, còn nội dung vẫn như đã nói ở trên.

[Kieu Tan 22]

Vậy là làm không đúng theo hướng dẫn, file ở trên chỉ chuyển sang fas, còn nội dung vẫn như đã nói ở trên.

Không phải đâu bạn ơi ! 

Làm theo hứơng dẫn nhưng nó cho dầu ra sai mà. 

[quocmanh04tt 635]

Post cái lisp bạn đã sửa lên, tôi sẽ chỉ cho bạn chỗ không đúng theo hướng dẫn.

Hoặc copy cái này rồi chạy và so sánh:

(defun LM:UnFormat  (str mtx / _replace rx)
 (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))
 (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
  (progn (setq str (vl-catch-all-apply
                    (function
                     (lambda ()
                      (vlax-put-property rx 'global actrue)
                      (vlax-put-property rx 'multiline actrue)
                      (vlax-put-property rx 'ignorecase acfalse)
                      (foreach pair  '(("\032" . "\\\\\\\\")
                                       (" " . "\\\\P|\\n|\\t")
                                       ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                       ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                       ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
                                       ("$1" . "[\\\\]({)|{"))
                       (setq str (_replace (car pair) (cdr pair) str)))
                      (if mtx
                       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                       (_replace "\\" "\032" str))))))
         (vlax-release-object rx)
         (if (null (vl-catch-all-error-p str))
          str))))
(defun c:tkt  (/ make-Text hei lst pt ss str sty)
 (defun make-Text  (pt hgt str sty)
  (entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))
 (and (vl-load-com)
      (princ "\nQuet chon Text, Mtext de thong ke...!")
      (setq ss (ssget (list (cons 0 "*TEXT"))))
      (foreach e  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (setq str (LM:UnFormat (cdr (assoc 1 (entget e))) nil)
             hei (cdr (assoc 40 (entget e))))
       (if (not (assoc str lst))
        (setq lst (cons (cons str (list (cons 1 e))) lst))
        (setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))
      (setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))
                      (hei)))
      (setq pt (getpoint "\nDiem dat Bang: "))
      (foreach e  (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))
       (make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))
       (make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)
       (setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))
 (princ))

[Kieu Tan 22]

(defun c:tkt1 (/ make-Text hei lst pt ss str sty)

(defun make-Text (pt hgt str sty)

(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

(and (vl-load-com)

(princ "\nQuet chon Text, Mtext de thong ke...!")

(setq ss (ssget (list (cons 0 "*TEXT"))))

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

(setq str (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

hei (cdr (assoc 40 (entget e))))

(if (not (assoc str lst))

(setq lst (cons (cons str (list (cons 1 e))) lst))

(setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

(setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

(hei)))

(setq pt (getpoint "\nDiem dat Bang: "))

(foreach e (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

(make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

(make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

(setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

(princ))



(defun LM:UnFormat (str mtx / _replace rx)
(defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn (setq str (vl-catch-all-apply
(function
(lambda ()
(vlax-put-property rx 'global actrue)
(vlax-put-property rx 'multiline actrue)
(vlax-put-property rx 'ignorecase acfalse)
(foreach pair '(("\032" . "\\\\\\\\")
(" " . "")
("" . "\\\\(\\\\[ACcFfHLlOopQTW]);]*;|\\\\[ACcFfHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{"))
(setq str (_replace (car pair) (cdr pair) str)))
(if mtx
(_replace "\\\\" "" (_replace "" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_replace "" "" str))))))
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str))
str)))) 

Post cái lisp bạn đã sửa lên, tôi sẽ chỉ cho bạn chỗ không đúng theo hướng dẫn.

Hoặc copy cái này rồi chạy và so sánh:

(defun LM:UnFormat  (str mtx / _replace rx)

 (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))

 (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))

  (progn (setq str (vl-catch-all-apply

                    (function

                     (lambda ()

                      (vlax-put-property rx 'global actrue)

                      (vlax-put-property rx 'multiline actrue)

                      (vlax-put-property rx 'ignorecase acfalse)

                      (foreach pair  '(("\032" . "\\\\\\\\")

                                       (" " . "\\\\P|\\n|\\t")

                                       ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")

                                       ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")

                                       ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")

                                       ("$1" . "[\\\\]({)|{"))

                       (setq str (_replace (car pair) (cdr pair) str)))

                      (if mtx

                       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))

                       (_replace "\\" "\032" str))))))

         (vlax-release-object rx)

         (if (null (vl-catch-all-error-p str))

          str))))

(defun c:tkt  (/ make-Text hei lst pt ss str sty)

 (defun make-Text  (pt hgt str sty)

  (entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

 (and (vl-load-com)

      (princ "\nQuet chon Text, Mtext de thong ke...!")

      (setq ss (ssget (list (cons 0 "*TEXT"))))

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

       (setq str (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

             hei (cdr (assoc 40 (entget e))))

       (if (not (assoc str lst))

        (setq lst (cons (cons str (list (cons 1 e))) lst))

        (setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

      (setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

                      (hei)))

      (setq pt (getpoint "\nDiem dat Bang: "))

      (foreach e  (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

       (make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

       (make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

       (setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

 (princ))

Coppy cái của bạn về cũng không ổn

Và cái của mình đây và nó cũng không được luôn:

 

(defun c:tkt1 (/ make-Text hei lst pt ss str sty)

 

(defun make-Text (pt hgt str sty)

 

(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

 

(and (vl-load-com)

 

(princ "\nQuet chon Text, Mtext de thong ke...!")

 

(setq ss (ssget (list (cons 0 "*TEXT"))))

 

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

 

(setq str (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

 

hei (cdr (assoc 40 (entget e))))

 

(if (not (assoc str lst))

 

(setq lst (cons (cons str (list (cons 1 e))) lst))

 

(setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

 

(setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

 

(hei)))

 

(setq pt (getpoint "\nDiem dat Bang: "))

 

(foreach e (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

 

(make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

 

(make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

 

(setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

 

(princ))

 

 

 

(defun LM:UnFormat (str mtx / _replace rx)

(defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))

(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))

(progn (setq str (vl-catch-all-apply

(function

(lambda ()

(vlax-put-property rx 'global actrue)

(vlax-put-property rx 'multiline actrue)

(vlax-put-property rx 'ignorecase acfalse)

(foreach pair '(("\032" . "\\\\\\\\")

(" " . "")

("" . "\\\\(\\\\[ACcFfHLlOopQTW]);]*;|\\\\[ACcFfHLlOopQTW]")

("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")

("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")

("$1" . "[\\\\]({)|{"))

(setq str (_replace (car pair) (cdr pair) str)))

(if mtx

(_replace "\\\\" "" (_replace "" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))

(_replace "" "" str))))))

(vlax-release-object rx)

(if (null (vl-catch-all-error-p str))

str))))

Chỉnh sửa Tháng 8 21, 2016 theo Kieu Tan

[quocmanh04tt 635]

Post cái lisp bạn đã sửa lên, tôi sẽ chỉ cho bạn chỗ không đúng theo hướng dẫn.

Hoặc copy cái này rồi chạy và so sánh:

(defun LM:UnFormat  (str mtx / _replace rx)

 (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))

 (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))

  (progn (setq str (vl-catch-all-apply

                    (function

                     (lambda ()

                      (vlax-put-property rx 'global actrue)

                      (vlax-put-property rx 'multiline actrue)

                      (vlax-put-property rx 'ignorecase acfalse)

                      (foreach pair  '(("\032" . "\\\\\\\\")

                                       (" " . "\\\\P|\\n|\\t")

                                       ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")

                                       ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")

                                       ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")

                                       ("$1" . "[\\\\]({)|{"))

                       (setq str (_replace (car pair) (cdr pair) str)))

                      (if mtx

                       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))

                       (_replace "\\" "\032" str))))))

         (vlax-release-object rx)

         (if (null (vl-catch-all-error-p str))

          str))))

(defun c:tkt  (/ make-Text hei lst pt ss str sty)

 (defun make-Text  (pt hgt str sty)

  (entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 10 pt) (cons 40 hgt) (cons 1 str))))

 (and (vl-load-com)

      (princ "\nQuet chon Text, Mtext de thong ke...!")

      (setq ss (ssget (list (cons 0 "*TEXT"))))

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

       (setq str (LM:UnFormat (cdr (assoc 1 (entget e))) nil)

             hei (cdr (assoc 40 (entget e))))

       (if (not (assoc str lst))

        (setq lst (cons (cons str (list (cons 1 e))) lst))

        (setq lst (subst (cons str (list (cons (1+ (caadr (assoc str lst))) e))) (assoc str lst) lst))))

      (setq hei (cond ((getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos hei 2 2) ">: ")))

                      (hei)))

      (setq pt (getpoint "\nDiem dat Bang: "))

      (foreach e  (vl-sort lst '(lambda (x y) (< (caadr x) (caadr y))))

       (make-Text pt hei (itoa (caadr e)) (setq sty (cdr (assoc 7 (entget (cdadr e))))))

       (make-Text (polar pt 0 (* 5 hei)) hei (car e) sty)

       (setq pt (polar pt (* pi 1.5) (* 1.75 hei)))))

 (princ))

Thử so sánh lisp của bạn với lsp gốc dòng được đánh dấu màu đỏ có không hay có giống không?

Hoặc vào đây: http://www.lee-mac.com/unformatstring.htmltải hàm của LM về.