Xin các sếp chỉ giáo lisp gộp nhanh các text thành mtext theo hàng ngang hoặc dọc chỉ với 1 lệnh ạ

[TrungTNR 0]

Xin các sếp chỉ giáo lisp gộp nhanh các text thành mtext theo hàng ngang hoặc dọc chỉ với 1 lệnh ạ. 

[cuongtk2 483]

có lệnh TXT2MTXT

[TrungTNR 0]

Dùng lệnh này sẽ bị gom hết các text lại ấy ạ. Em muốn quét 1 lần mà chọn theo hàng hoặc côt ấy ạ.

[cuongtk2 483]

Xem SEting của lệnh, chắc nó có option

[Nguyễn Hà Huy 52]

thiếu gì thì cứ vào cụ leemac tìm nhé
Text2MText | Lee Mac Programming
https://www.lee-mac.com/text2mtext.html

[TrungTNR 0]

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

[TrungTNR 0]

Vừa xong, 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)
)
 

Hiện tại em tìm được trên 1wweb ghép các text theo chiều ngang rồi ạ. Mong các sếp chỉ giáo sửa code chỉnh thêm ghép text theo chiều dọc ạ.

[cuongtk2 483]

Với InsertionPoint :Hàm này không thể ghép text gần như cùng hàng, hoặc text justify khác nhau trên cùng 1 hàng. 

Hãy test với 2 hàng, trong đó 1 text move xuống chút xíu, hoặc đặt lại justify thành TopLeft.

Đánh giá: tiếp tục nhờ GPT dùng chiều cao của boundingbox với sai lệch minpoint khoảng 50-100%h để gom lại thành hàng. 

[Tap.Ve.Cad 27]

@TrungTNR Bạn dùng thử code này xem

Có 2 tính năng : 1 là thứ tự text theo thứ tự chọn của người dùng (Select), 2 là thứ tự theo trục Y khi người dùng chọn 1 nhóm text hoặc Mtext để gộp về 1 Mtext

 

(defun C:T2MV (/ ss n txtlst mtext-content txtstyle txtheight sortchoice)
  (vl-load-com)
  
  (defun get-text-bottom-y (ename)
    (setq ent (entget ename))
    (setq entity-type (cdr (assoc 0 ent)))
    
    (if (= entity-type "TEXT")
      (progn
        (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))
          ((or (= txt-align 1) (= txt-align 2)) (cadr pt10))
          ((= txt-align 6) (cadr pt10))
          ((= txt-align 7) (cadr pt10))
          ((= txt-align 8) (cadr pt10))
          (T (- (cadr pt10) txt-height))
        )
      )
      (progn
        (setq pt10 (cdr (assoc 10 ent)))
        (setq txt-height (cdr (assoc 40 ent)))
        (setq att-align (cdr (assoc 71 ent)))
        
        (cond
          ((= att-align 1) (cadr pt10))
          ((= att-align 2) (- (cadr pt10) (/ txt-height 2.0)))
          ((= att-align 3) (- (cadr pt10) txt-height))
          (T (cadr pt10))
        )
      )
    )
  )

  (defun get-text-content (ename)
    (setq ent (entget ename))
    (setq entity-type (cdr (assoc 0 ent)))
    
    (if (= entity-type "TEXT")
      (cdr (assoc 1 ent))
      (cdr (assoc 1 ent))
    )
  )

  (initget 1 "Select TrucY")
  (setq sortchoice (getkword "\nSap xep theo [Select/TrucY]: "))
  (princ "\nChon cac doi tuong TEXT va MTEXT de gop...")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  
  (if ss
    (progn
      (setq n 0
            txtlst nil)
      (repeat (sslength ss)
        (setq txtlst (cons (ssname ss n) txtlst)
              n (1+ n)))
      
      (if (= sortchoice "TrucY")
        (setq txtlst (vl-sort txtlst
                             '(lambda (a b)
                                (> (get-text-bottom-y a)
                                   (get-text-bottom-y b)))))
        (setq txtlst (reverse txtlst)))
      
      (setq first-ent (car txtlst))
      (setq first-ent-data (entget first-ent))
      
      (setq ptbase (assoc 10 first-ent-data)
            txtstyle (cdr (assoc 7 first-ent-data))
            txtheight (cdr (assoc 40 first-ent-data)))
      
      (setq mtext-content "")
      (foreach ent txtlst
        (setq mtext-content (strcat mtext-content
                                     (get-text-content ent)
                                     "\\P")))
      
      (entmakex (list
                 '(0 . "MTEXT")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbMText")
                 ptbase
                 (cons 40 txtheight)
                 (cons 7 txtstyle)
                 (cons 1 mtext-content)
                 '(71 . 1)
                 '(72 . 5)
                 ))
      
      (foreach ent txtlst
        (entdel ent))
      
      (princ "\nDa gop van ban va sap xep theo yeu cau!")
    )
    (princ "\nKhong co doi tuong van ban nao duoc chon!"))
  (princ)
)

[TrungTNR 0]

Này em thấy bị gom hết các text cùng 1 cột rồi ấy ạ. Ý em là có nhiều cột text cạnh nhau. Mình muốn quét 1 lần mà gom thành các mtext nhưng vẫn giữ nguyên các cột ấy ạ. 

[cuongtk2 483]

Đề xuất của bạn chưa hiểu để phục vụ mục tiêu gì. Như kiểu dự thầu mà không có tiêu chí đánh giá thì không bao giờ trúng được.  

[tantbd44 1]

Bạn tham khảo: https://www.theswamp.org/index.php?topic=35607.0

[TrungTNR 0]

Vào lúc 11/8/2025 tại 10:39, cuongtk2 đã nói:

Đề xuất của bạn chưa hiểu để phục vụ mục tiêu gì. Như kiểu dự thầu mà không có tiêu chí đánh giá thì không bao giờ trúng được.  

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

 

Sếp xem giúp em với ạ. Em muốn gộp như video này ạ.

[cuongtk2 483]

Xem và download tại mục Lập trình khác.

[TommyLe 1]

Gộp như này có được không bạn?

 

[luatduongtri 0]

Nếu bác Cần Xem Về Phần Mềm Thì Bác Vào Đây Nhé 

https://luatduongtri.vn/ Hoặc cần tư vấn luật pháp liên quan tới phần mềm  thì liên hệ nhé