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

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

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

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

  • 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

đổ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 đó. 

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

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

145520_untitled.jpgBạ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

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ô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.

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

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.

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

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! 

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

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ủ 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 :145520_untitled1.jpg

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ắ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.

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ắ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:

145520_untitled_2.jpg

145520_untitled1_2.jpg

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

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

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

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

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: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 theo Kieu Tan

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

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ề.

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  

×