Chuyển đến nội dung
Diễn đàn CADViet
Thanh TV

[Hướng dẫn] Nhờ sự trợ giúp từ mọi người: Sửa lisp tìm text có giá trị text valua giống với text mẫu được chọn.

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

Em có tìm trên web một lisp tìm text cùng giá trị (text value bằng nhau) trên bản vẽ, nhưng phải chọn từng text mẫu rồi chọn vùng chứa text cần tìm.
Mong muốn mọi người chỉnh sửa, cải tiến thêm nội dung để phục vụ công việc được tốt hơn, cụ thể như sau:

B1: Nhập lệnh 

B2: Chọn một hoặc nhóm text mẫu (ví dụ: text mẫu hoặc nhóm text mẫu có giá trị text valua lần lượt là 17, 18, 19)

B3: Chọn vùng text cần tìm theo text mẫu đã chọn

B4: Hiện kết quả tìm được. (hiện tất cả các text có giá trị text valua lần lượt là 17, 18, 19)

Cảm ơn!

Lisp hiện có như sau:

TIM TEXT CUNG GIA TRI
(defun C:jk( / i txt ent)
(setq i 1 txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau: "))))))
(while (setq ent (car (entsel (strcat "\nChon Text mau " (itoa i) ": "))))
 (setq txt (strcat txt "," (cdr (assoc 1 (entget ent)))))
  (setq i (1+ i)))
(princ "\nChon nhom Text...")
(setq ss (ssget (list '(0 . "*TEXT") (cons 1 txt))))
(sssetfirst nil ss))

JK - TIM TEXT CUNG GIA TRI.lsp

  • 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
Vào lúc 19/7/2022 tại 14:49, Thanh TV đã nói:

Em có tìm trên web một lisp tìm text cùng giá trị (text value bằng nhau) trên bản vẽ, nhưng phải chọn từng text mẫu rồi chọn vùng chứa text cần tìm.
Mong muốn mọi người chỉnh sửa, cải tiến thêm nội dung để phục vụ công việc được tốt hơn, cụ thể như sau:

B1: Nhập lệnh 

B2: Chọn một hoặc nhóm text mẫu (ví dụ: text mẫu hoặc nhóm text mẫu có giá trị text valua lần lượt là 17, 18, 19)

B3: Chọn vùng text cần tìm theo text mẫu đã chọn

B4: Hiện kết quả tìm được. (hiện tất cả các text có giá trị text valua lần lượt là 17, 18, 19)

Cảm ơn!

Lisp hiện có như sau:

TIM TEXT CUNG GIA TRI
(defun C:jk( / i txt ent)
(setq i 1 txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau: "))))))
(while (setq ent (car (entsel (strcat "\nChon Text mau " (itoa i) ": "))))
 (setq txt (strcat txt "," (cdr (assoc 1 (entget ent)))))
  (setq i (1+ i)))
(princ "\nChon nhom Text...")
(setq ss (ssget (list '(0 . "*TEXT") (cons 1 txt))))
(sssetfirst nil ss))

JK - TIM TEXT CUNG GIA TRI.lsp

đây bạn

 

JK - TIM TEXT CUNG GIA TRI.lsp

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ào lúc 8/7/2025 tại 11:03, trieubb đã nói:

(defun c:JJM ( / ss tol rows i ent obj insX insY text rowsGrouped
                  doc spc baseHeight insPt row rowlist line newMText)
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                    (eq :vlax-true (vla-get-MSpace doc)))
              (vla-get-ModelSpace doc)
              (vla-get-PaperSpace doc)))

  (setq tol 0.5) ;; Dung sai theo Y d? nh?n cùng hàng

  (if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
    (progn
      ;; Gom MText theo hàng (theo Y)
      (setq rowsGrouped '()
            i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i)
              i (1+ i))
        (if ent
          (progn
            (setq obj (vlax-ename->vla-object ent)
                  insX (car  (vlax-get obj 'InsertionPoint))
                  insY (cadr (vlax-get obj 'InsertionPoint))
                  text (vla-get-TextString obj))
            ;; Tìm hàng g?n insY
            (setq found nil)
            (foreach row rowsGrouped
              (if (< (abs (- insY (car row))) tol)
                (progn
                  (setq rowsGrouped
                        (subst (cons (car row)
                                     (append (cdr row)
                                             (list (list insX text ent obj))))
                               row
                               rowsGrouped))
                  (setq found T))))
            (if (not found)
              (setq rowsGrouped
                    (append rowsGrouped
                            (list (cons insY (list (list insX text ent obj)))))))))
      )

      ;; S?p x?p các hàng theo Y gi?m d?n
      (setq rowsGrouped (vl-sort rowsGrouped '(lambda (a b) (> (car a) (car b)))))

      ;; L?y chi?u cao theo MText d?u tiên
      (setq firstRow (car rowsGrouped))
      (setq firstMText (car (vl-sort (cdr firstRow) '(lambda(a b) (< (car a) (car b))))))
      (setq baseHeight (vla-get-Height (cadddr firstMText)))

      ;; Kho?ng cách gi?a các hàng m?i (1.5 l?n chi?u cao)
      (setq rowSpacing (* 1.5 baseHeight))

      ;; Ch?n di?m d?t g?c
      (setq insPt (getpoint "\nSpecify insert point: "))
      (if insPt
        (progn
          (setq currentPt insPt)
          ;; X? lý t?ng hàng
          (foreach row rowsGrouped
            ;; s?p x?p hàng theo X tang d?n
            (setq rowlist (vl-sort (cdr row) '(lambda(a b) (< (car a) (car b)))))
            ;; N?i n?i dung b?ng " - "
            (setq line (apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) " - ")) rowlist)))
            (setq line (vl-string-left-trim " " (vl-string-right-trim "- " line)))

            ;; T?o MText cho t?ng hàng
            (setq newMText (vla-AddMText spc (vlax-3d-point currentPt) 0.0 line))
            (vla-put-AttachmentPoint newMText acAttachmentPointTopLeft)
            (vla-put-Height newMText baseHeight)

            ;; D?i di?m Y xu?ng cho hàng ti?p theo
            (setq currentPt (list (car currentPt) (- (cadr currentPt) rowSpacing) (caddr currentPt)))
          )
        )
      )
    )
  )

  (princ)
)
 

 

 

Mong anh chỉ giáo sửa giúp em lệnh này ghép text theo chiều dọ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
Vào lúc 9/8/2025 tại 09:12, TrungTNR đã nói:

(defun c:JJM ( / ss tol rows i ent obj insX insY text rowsGrouped
                  doc spc baseHeight insPt row rowlist line newMText)
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                    (eq :vlax-true (vla-get-MSpace doc)))
              (vla-get-ModelSpace doc)
              (vla-get-PaperSpace doc)))

  (setq tol 0.5) ;; Dung sai theo Y d? nh?n cùng hàng

  (if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
    (progn
      ;; Gom MText theo hàng (theo Y)
      (setq rowsGrouped '()
            i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i)
              i (1+ i))
        (if ent
          (progn
            (setq obj (vlax-ename->vla-object ent)
                  insX (car  (vlax-get obj 'InsertionPoint))
                  insY (cadr (vlax-get obj 'InsertionPoint))
                  text (vla-get-TextString obj))
            ;; Tìm hàng g?n insY
            (setq found nil)
            (foreach row rowsGrouped
              (if (< (abs (- insY (car row))) tol)
                (progn
                  (setq rowsGrouped
                        (subst (cons (car row)
                                     (append (cdr row)
                                             (list (list insX text ent obj))))
                               row
                               rowsGrouped))
                  (setq found T))))
            (if (not found)
              (setq rowsGrouped
                    (append rowsGrouped
                            (list (cons insY (list (list insX text ent obj)))))))))
      )

      ;; S?p x?p các hàng theo Y gi?m d?n
      (setq rowsGrouped (vl-sort rowsGrouped '(lambda (a b) (> (car a) (car b)))))

      ;; L?y chi?u cao theo MText d?u tiên
      (setq firstRow (car rowsGrouped))
      (setq firstMText (car (vl-sort (cdr firstRow) '(lambda(a b) (< (car a) (car b))))))
      (setq baseHeight (vla-get-Height (cadddr firstMText)))

      ;; Kho?ng cách gi?a các hàng m?i (1.5 l?n chi?u cao)
      (setq rowSpacing (* 1.5 baseHeight))

      ;; Ch?n di?m d?t g?c
      (setq insPt (getpoint "\nSpecify insert point: "))
      (if insPt
        (progn
          (setq currentPt insPt)
          ;; X? lý t?ng hàng
          (foreach row rowsGrouped
            ;; s?p x?p hàng theo X tang d?n
            (setq rowlist (vl-sort (cdr row) '(lambda(a b) (< (car a) (car b)))))
            ;; N?i n?i dung b?ng " - "
            (setq line (apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) " - ")) rowlist)))
            (setq line (vl-string-left-trim " " (vl-string-right-trim "- " line)))

            ;; T?o MText cho t?ng hàng
            (setq newMText (vla-AddMText spc (vlax-3d-point currentPt) 0.0 line))
            (vla-put-AttachmentPoint newMText acAttachmentPointTopLeft)
            (vla-put-Height newMText baseHeight)

            ;; D?i di?m Y xu?ng cho hàng ti?p theo
            (setq currentPt (list (car currentPt) (- (cadr currentPt) rowSpacing) (caddr currentPt)))
          )
        )
      )
    )
  )

  (princ)
)
 

 

 

Mong anh chỉ giáo sửa giúp em lệnh này ghép text theo chiều dọc ạ.

đây bạn

(defun c:T130 ( / mode ss tol groups i ent obj insX insY text doc spc
                  baseHeight insPt currentPt sortedGroup groupList line newMText)
  (vl-load-com)
  ;; Lấy document và không gian làm việc
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        spc (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
                    (eq :vlax-true (vla-get-MSpace doc)))
              (vla-get-ModelSpace doc)
              (vla-get-PaperSpace doc)))

  ;; Chọn chế độ gom
  (initget "H C")
  (setq mode (getkword "\nChọn chế độ gom [Hàng/Cột] <H>: "))
  (if (not mode) (setq mode "H")) ;; mặc định gom hàng

  (setq tol 0.5) ;; Dung sai theo trục so sánh

  ;; Chọn TEXT/MTEXT
  (if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
    (progn
      (setq groups '()
            i 0)
      ;; Gom nhóm
      (repeat (sslength ss)
        (setq ent (ssname ss i)
              i (1+ i))
        (if ent
          (progn
            (setq obj (vlax-ename->vla-object ent)
                  insX (car  (vlax-get obj 'InsertionPoint))
                  insY (cadr (vlax-get obj 'InsertionPoint))
                  text (vla-get-TextString obj))
            (setq found nil)
            (foreach grp groups
              (if (if (= mode "H")
                    (< (abs (- insY (car grp))) tol) ;; so sánh Y cho hàng
                    (< (abs (- insX (car grp))) tol) ;; so sánh X cho cột
                  )
                (progn
                  (setq groups
                        (subst (cons (car grp)
                                     (append (cdr grp)
                                             (list (list (if (= mode "H") insX insY)
                                                         text ent obj))))
                               grp
                               groups))
                  (setq found T))))
            (if (not found)
              (setq groups
                    (append groups
                            (list (cons (if (= mode "H") insY insX)
                                        (list (list (if (= mode "H") insX insY)
                                                    text ent obj))))))))
        )
      )

      ;; Sắp xếp nhóm
      (setq groups (vl-sort groups
                            (if (= mode "H")
                              '(lambda (a b) (> (car a) (car b))) ;; hàng: Y giảm
                              '(lambda (a b) (< (car a) (car b))) ;; cột: X tăng
                            )))

      ;; Lấy chiều cao chuẩn
      (setq firstGroup (car groups))
      (setq firstText (car (vl-sort (cdr firstGroup)
                                    (if (= mode "H")
                                      '(lambda(a b) (< (car a) (car b))) ;; hàng: X tăng
                                      '(lambda(a b) (> (car a) (car b))) ;; cột: Y giảm
                                    ))))
      (setq baseHeight (vla-get-Height (cadddr firstText)))

      ;; Khoảng cách giữa các nhóm
      (setq groupSpacing (if (= mode "H")
                           (* 1.5 baseHeight) ;; hàng: dãn theo Y
                           (* 4 baseHeight)   ;; cột: dãn theo X
                         ))

      ;; Chọn điểm chèn
      (setq insPt (getpoint "\nChỉ định điểm chèn: "))
      (if insPt
        (progn
          (setq currentPt insPt)
          (foreach grp groups
            ;; Sắp xếp trong nhóm
            (setq groupList (vl-sort (cdr grp)
                                     (if (= mode "H")
                                       '(lambda(a b) (< (car a) (car b))) ;; hàng: X tăng
                                       '(lambda(a b) (> (car a) (car b))) ;; cột: Y giảm
                                     )))
            ;; Nối nội dung
            (setq line (if (= mode "H")
                         (apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) " - ")) groupList))
                         (apply 'strcat (mapcar '(lambda(x) (strcat (cadr x) "\\P")) groupList))
                       ))
            (setq line (vl-string-left-trim " " (vl-string-right-trim (if (= mode "H") "- " "\\P") line)))

            ;; Tạo MText
            (setq newMText (vla-AddMText spc (vlax-3d-point currentPt) 0.0 line))
            (vla-put-AttachmentPoint newMText acAttachmentPointTopLeft)
            (vla-put-Height newMText baseHeight)

            ;; Dời vị trí
            (if (= mode "H")
              ;; xuống hàng
              (setq currentPt (list (car currentPt)
                                    (- (cadr currentPt) groupSpacing)
                                    (caddr currentPt)))
              ;; sang phải
              (setq currentPt (list (+ (car currentPt) groupSpacing)
                                    (cadr currentPt)
                                    (caddr currentPt)))
            )
          )
        )
      )
    )
  )

  (princ)
)
 

  • Like 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ảm ơn ạ. Lisp này nếu mà text bị lệch nhau 1 tý sẽ k nhận các text gộp chung lại được và bị thiếu text ạ. Anh xem chỉnh lại thêm giúp em 1 tý vớ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
2 giờ trước, TrungTNR đã nói:

Em cảm ơn ạ. Lisp này nếu mà text bị lệch nhau 1 tý sẽ k nhận các text gộp chung lại được và bị thiếu text ạ. Anh xem chỉnh lại thêm giúp em 1 tý với ạ.

Bạn nên làm một cái file cad minh họa hoặc hình minh họa trước khi dùng lisp thì như nào, sau khi dung lisp như nào thì mọi người mới giúp được. Trên này thấy có nhiều thầy bói mù quá .

  • Like 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

https://www.mediafire.com/file/kauojsa9b3272ct/gop_text_theo_hang_ngang.mp4/file

3 giờ trước, Tap.Ve.Cad đã nói:

Bạn nên làm một cái file cad minh họa hoặc hình minh họa trước khi dùng lisp thì như nào, sau khi dung lisp như nào thì mọi người mới giúp được. Trên này thấy có nhiều thầy bói mù quá .

Các sếp xem chỉnh giúp em với ạ. 1 số text khi gom vào thì không gom hết vào được thành mtext mà vẫn là các text đơn

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 thử lisp này xem, kết hợp cả dọc và ngang trong 1 lisp:

 

(defun C:T2MV (/ ss n txtlst ptbase strlst mtext txtstyle txtheight sortchoice col-tol row-data)
  (vl-load-com)

  (defun get-text-y (txt-ename)
    (setq ent (entget txt-ename))
    (setq pt10 (cdr (assoc 10 ent)))
    (setq txt-height (cdr (assoc 40 ent)))
    (setq txt-align (cdr (assoc 72 ent)))
    (cond
      ((= txt-align 0) (cadr pt10))
      ((= txt-align 1) (cadr pt10))
      ((= txt-align 2) (cadr pt10))
      ((= txt-align 3) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 4) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 5) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 6) (- (cadr pt10) txt-height))
      ((= txt-align 7) (- (cadr pt10) txt-height))
      ((= txt-align 8) (- (cadr pt10) txt-height))
      ((= txt-align 9) (cadr pt10))
      ((= txt-align 10) (cadr pt10))
      ((= txt-align 11) (cadr pt10))
      ((= txt-align 12) (cadr pt10))
      ((= txt-align 13) (cadr pt10))
      ((= txt-align 14) (cadr pt10))
      (T (cadr pt10))
    )
  )

  (defun get-text-x (txt-ename)
    (car (cdr (assoc 10 (entget txt-ename))))
  )

  ;; Đã sửa: Bỏ tùy chọn Select
  (initget "Doc Ngang")
  (setq sortchoice (getkword "\nSap xep theo [Doc/Ngang]: "))

  (setq col-tol (getreal "\nNhap khoang cach toi da giua cac cot/hang (mac dinh 1.0): "))
  (if (null col-tol) (setq col-tol 1.0))

  (princ "\nChon cac doi tuong TEXT de chuyen thanh MTEXT...")
  (setq ss (ssget '((0 . "TEXT"))))
  (if ss
    (progn
      (setq n 0 txtlst nil)
      (repeat (sslength ss)
        (setq txtlst (cons (ssname ss n) txtlst)
              n (1+ n)))

      (setq row-data nil)

      (cond
        ((= sortchoice "Doc")
         ;; Xử lý ghép cột (Doc)
         (setq columns (vl-sort txtlst '(lambda (a b) (< (get-text-x a) (get-text-x b)))))
         (foreach txt columns
           (setq x-pos (get-text-x txt))
           (setq found nil)
           (foreach col row-data
             (if (< (abs (- x-pos (car col))) col-tol)
               (progn
                 (setq row-data (subst (cons (car col) (cons txt (cdr col))) col row-data))
                 (setq found T)
               )
             )
           )
           (if (not found)
             (setq row-data (cons (list x-pos txt) row-data))
           )
         )
         (setq row-data (vl-sort row-data '(lambda (a b) (< (car a) (car b)))))
         (foreach col row-data
           (setq col-txt (cdr col))
           (setq col-txt (vl-sort col-txt '(lambda (a b) (> (get-text-y a) (get-text-y b)))))
           (setq ptbase (assoc 10 (entget (car col-txt)))
                 txtstyle (cdr (assoc 7 (entget (car col-txt))))
                 txtheight (cdr (assoc 40 (entget (car col-txt)))))

           (setq strlst "")
           (foreach txt col-txt
             (setq strlst (strcat strlst (cdr (assoc 1 (entget txt))) "\\P")))
           (setq strlst (substr strlst 1 (- (strlen strlst) 2)))

           (entmakex (list
                       '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       ptbase
                       (cons 40 txtheight)
                       (cons 7 txtstyle)
                       (cons 1 strlst)
                       '(71 . 1)
                       '(72 . 1)
                       ))
         )
        )

        ((= sortchoice "Ngang")
         ;; Xử lý ghép hàng (Ngang)
         (setq rows (vl-sort txtlst '(lambda (a b) (> (get-text-y a) (get-text-y b)))))
         (setq row-data nil)
         (foreach txt rows
           (setq y-pos (get-text-y txt))
           (setq found nil)
           (foreach row row-data
             (if (< (abs (- y-pos (car row))) col-tol)
               (progn
                 (setq row-data (subst (cons (car row) (cons txt (cdr row))) row row-data))
                 (setq found T)
               )
             )
           )
           (if (not found)
             (setq row-data (cons (list y-pos txt) row-data))
           )
         )

         (setq row-data (vl-sort row-data '(lambda (a b) (> (car a) (car b)))))
         (foreach row row-data
           (setq row-txt (cdr row))
           (setq row-txt (vl-sort row-txt '(lambda (a b) (< (get-text-x a) (get-text-x b)))))
           (setq ptbase (assoc 10 (entget (car row-txt)))
                 txtstyle (cdr (assoc 7 (entget (car row-txt))))
                 txtheight (cdr (assoc 40 (entget (car row-txt)))))

           (setq strlst "")
           (foreach txt row-txt
             (setq strlst (strcat strlst (cdr (assoc 1 (entget txt))) " ")))
           (setq strlst (substr strlst 1 (- (strlen strlst) 1)))

           (entmakex (list
                       '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       ptbase
                       (cons 40 txtheight)
                       (cons 7 txtstyle)
                       (cons 1 strlst)
                       '(71 . 1)
                       '(72 . 1)
                       (cons 41 0.0)
                       ))
         )
        )
      )

      (foreach txt txtlst
        (entdel txt))

      (princ "\nDa chuyen TEXT thanh MTEXT theo cac cot/hang va sap xep theo yeu cau!"))
    (princ "\nKhong co doi tuong TEXT nao duoc chon!"))
  (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
10 phút trước, Tap.Ve.Cad đã nói:

Bạn dùng thử lisp này xem, kết hợp cả dọc và ngang trong 1 lisp:

 

(defun C:T2MV (/ ss n txtlst ptbase strlst mtext txtstyle txtheight sortchoice col-tol row-data)
  (vl-load-com)

  (defun get-text-y (txt-ename)
    (setq ent (entget txt-ename))
    (setq pt10 (cdr (assoc 10 ent)))
    (setq txt-height (cdr (assoc 40 ent)))
    (setq txt-align (cdr (assoc 72 ent)))
    (cond
      ((= txt-align 0) (cadr pt10))
      ((= txt-align 1) (cadr pt10))
      ((= txt-align 2) (cadr pt10))
      ((= txt-align 3) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 4) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 5) (- (cadr pt10) (/ txt-height 2.0)))
      ((= txt-align 6) (- (cadr pt10) txt-height))
      ((= txt-align 7) (- (cadr pt10) txt-height))
      ((= txt-align 8) (- (cadr pt10) txt-height))
      ((= txt-align 9) (cadr pt10))
      ((= txt-align 10) (cadr pt10))
      ((= txt-align 11) (cadr pt10))
      ((= txt-align 12) (cadr pt10))
      ((= txt-align 13) (cadr pt10))
      ((= txt-align 14) (cadr pt10))
      (T (cadr pt10))
    )
  )

  (defun get-text-x (txt-ename)
    (car (cdr (assoc 10 (entget txt-ename))))
  )

  ;; Đã sửa: Bỏ tùy chọn Select
  (initget "Doc Ngang")
  (setq sortchoice (getkword "\nSap xep theo [Doc/Ngang]: "))

  (setq col-tol (getreal "\nNhap khoang cach toi da giua cac cot/hang (mac dinh 1.0): "))
  (if (null col-tol) (setq col-tol 1.0))

  (princ "\nChon cac doi tuong TEXT de chuyen thanh MTEXT...")
  (setq ss (ssget '((0 . "TEXT"))))
  (if ss
    (progn
      (setq n 0 txtlst nil)
      (repeat (sslength ss)
        (setq txtlst (cons (ssname ss n) txtlst)
              n (1+ n)))

      (setq row-data nil)

      (cond
        ((= sortchoice "Doc")
         ;; Xử lý ghép cột (Doc)
         (setq columns (vl-sort txtlst '(lambda (a b) (< (get-text-x a) (get-text-x b)))))
         (foreach txt columns
           (setq x-pos (get-text-x txt))
           (setq found nil)
           (foreach col row-data
             (if (< (abs (- x-pos (car col))) col-tol)
               (progn
                 (setq row-data (subst (cons (car col) (cons txt (cdr col))) col row-data))
                 (setq found T)
               )
             )
           )
           (if (not found)
             (setq row-data (cons (list x-pos txt) row-data))
           )
         )
         (setq row-data (vl-sort row-data '(lambda (a b) (< (car a) (car b)))))
         (foreach col row-data
           (setq col-txt (cdr col))
           (setq col-txt (vl-sort col-txt '(lambda (a b) (> (get-text-y a) (get-text-y b)))))
           (setq ptbase (assoc 10 (entget (car col-txt)))
                 txtstyle (cdr (assoc 7 (entget (car col-txt))))
                 txtheight (cdr (assoc 40 (entget (car col-txt)))))

           (setq strlst "")
           (foreach txt col-txt
             (setq strlst (strcat strlst (cdr (assoc 1 (entget txt))) "\\P")))
           (setq strlst (substr strlst 1 (- (strlen strlst) 2)))

           (entmakex (list
                       '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       ptbase
                       (cons 40 txtheight)
                       (cons 7 txtstyle)
                       (cons 1 strlst)
                       '(71 . 1)
                       '(72 . 1)
                       ))
         )
        )

        ((= sortchoice "Ngang")
         ;; Xử lý ghép hàng (Ngang)
         (setq rows (vl-sort txtlst '(lambda (a b) (> (get-text-y a) (get-text-y b)))))
         (setq row-data nil)
         (foreach txt rows
           (setq y-pos (get-text-y txt))
           (setq found nil)
           (foreach row row-data
             (if (< (abs (- y-pos (car row))) col-tol)
               (progn
                 (setq row-data (subst (cons (car row) (cons txt (cdr row))) row row-data))
                 (setq found T)
               )
             )
           )
           (if (not found)
             (setq row-data (cons (list y-pos txt) row-data))
           )
         )

         (setq row-data (vl-sort row-data '(lambda (a b) (> (car a) (car b)))))
         (foreach row row-data
           (setq row-txt (cdr row))
           (setq row-txt (vl-sort row-txt '(lambda (a b) (< (get-text-x a) (get-text-x b)))))
           (setq ptbase (assoc 10 (entget (car row-txt)))
                 txtstyle (cdr (assoc 7 (entget (car row-txt))))
                 txtheight (cdr (assoc 40 (entget (car row-txt)))))

           (setq strlst "")
           (foreach txt row-txt
             (setq strlst (strcat strlst (cdr (assoc 1 (entget txt))) " ")))
           (setq strlst (substr strlst 1 (- (strlen strlst) 1)))

           (entmakex (list
                       '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       ptbase
                       (cons 40 txtheight)
                       (cons 7 txtstyle)
                       (cons 1 strlst)
                       '(71 . 1)
                       '(72 . 1)
                       (cons 41 0.0)
                       ))
         )
        )
      )

      (foreach txt txtlst
        (entdel txt))

      (princ "\nDa chuyen TEXT thanh MTEXT theo cac cot/hang va sap xep theo yeu cau!"))
    (princ "\nKhong co doi tuong TEXT nao duoc chon!"))
  (princ)
)

Lisp này em hôm trước em dùng thử rồi ạ. Nó gộp lại thành 1 text luô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
43 phút trước, Tap.Ve.Cad đã nói:

LIsp gộp thành mtext cho các đối tượng nhóm cột và nhóm hàng theo lựa chọn dọc hay ngang đúng ý bạn rồi mà nhỉ?

 

https://www.mediafire.com/file/ps9vcpjls64qx11/bandicam_2025-08-14_17-41-30-580.mp4/file

 

Anh xem lại giúp em với ạ. Nó vẫn không gom hết các text vào đượ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

Vì trong hàng text của bạn có những text bị lệch nên nó không gom về, 

 

Lưu ý: "Nhap khoang cach toi da giua cac cot/hang (mac dinh 1.0):" cái đoạn này bạn phải nhập khoảng cách lệch tối đa của các text muốn gom vào 1 hàng. Lưu ý khoảng cách lệch này phải nhỏ hơn khoảng cách của các hàng text của bạn.

  • Like 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
13 giờ trước, Tap.Ve.Cad đã nói:

Vì trong hàng text của bạn có những text bị lệch nên nó không gom về, 

 

Lưu ý: "Nhap khoang cach toi da giua cac cot/hang (mac dinh 1.0):" cái đoạn này bạn phải nhập khoảng cách lệch tối đa của các text muốn gom vào 1 hàng. Lưu ý khoảng cách lệch này phải nhỏ hơn khoảng cách của các hàng text của bạn.

Vậy liệu có cải tiến được không ạ. Nghĩa là sẽ có sai số cho những text lệch nhau 1 xíu có thể về cùng 1 mtexxt ạ,.

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

×