1. ;**************同行文字合并工具******************
    2. ;***本工具出品于：  Dcl-To-Lsp群(663130417)； ***
    3. ;***作者：青春散场，不诉离殇！(QQ:702099480)；***
    4. ;***时间：            2018年4月13日；         ***
    5. ;************************************************
    6. ;;2019.12.10优化有时不能合并的bug，增加文字行排序！
    8. (defun C:FV(/ delss endlst ent entlst entmlst entnow higy i n rowendlst rowlst ss startent_data)
    9.     (setvar "CMDECHO" 0)
    10.     (princ "\n选择合并文字：")
    11.     (if (setq ss (ssget '((0 . "*TEXT"))))
    12.         (progn
    13.             (setq entlst nil entmlst nil n 0)
    14.             (repeat (sslength ss)
    15.                 (setq ent (ssname ss n))
    16.                 (cond 
    17.                     ((= (cdr (assoc 0 (entget ent))) "TEXT")
    18.                         (setq entlst (cons (cons (cdr (assoc 10 (entget ent))) ent) entlst))
    19.                     )
    20.                     ((= (cdr (assoc 0 (entget ent))) "MTEXT")
    21.                         (setq entmlst (cons (cons (cdr (assoc 10 (entget ent))) ent) entmlst))
    22.                     )
    23.                 )
    24.                 (setq n (+ n 1))
    25.             )
    26.             (if entlst
    27.                 (progn
    28.                     (setq entlst (vl-sort entlst '(lambda (x y) (< (cadar x) (cadar y)))) higy (cadaar entlst) n 0 entnow nil rowlst nil rowendlst nil)
    29.                     (repeat (length entlst)
    30.                         (setq entnow (nth n entlst)) 
    31.                         (if (equal (cadar entnow) higy (/ (cdr (assoc 40 (entget (cdr entnow)))) 4.0))
    32.                             (progn (setq rowlst (append rowlst (list entnow))))
    33.                             (progn (setq rowendlst (append rowendlst (list rowlst)))
    34.                                 (setq rowlst (list entnow))
    35.                                 (setq higy (cadar entnow))
    36.                             )
    37.                         )
    38.                         (setq n (+ n 1))
    39.                         (if (= n (length entlst)) (setq rowendlst (append rowendlst (list rowlst))))
    40.                     )
    41.                     (command "_.UNDO" "be")
    42.                     (setq n 0 endlst nil)
    43.                     (repeat (length rowendlst)
    44.                         (setq endlst (vl-sort (nth n rowendlst) '(lambda (x y) (< (caar x) (caar y)))))
    45.                         (if (> (length endlst) 1)
    46.                             (progn
    47.                                 (setq startent_data (entget (cdr (car endlst))) i 1) 
    48.                                 (repeat (- (length endlst) 1)
    49.                                     (setq startent_data (subst (cons 1 (strcat (cdr (assoc 1 startent_data)) (cdr (assoc 1 (entget (cdr (nth i endlst))))))) (assoc 1 startent_data) startent_data))
    50.                                     (entmod startent_data)
    51.                                     (command "ERASE" (cdr (nth i endlst)) "")
    52.                                     (setq i (+ i 1))
    53.                                 )
    54.                             )
    55.                         )
    56.                         (setq n (1+ n))
    57.                     )
    58.                     (command "_.UNDO" "e")
    59.                 )
    60.             )
    61.             (if entmlst
    62.                 (progn
    63.                     (setq entmlst (vl-sort entmlst '(lambda (x y) (< (cadar x) (cadar y)))) higy (cadaar entmlst) n 0 entnow nil rowlst nil rowendlst nil)
    64.                     (repeat (length entmlst)
    65.                         (setq entnow (nth n entmlst)) 
    66.                         (if (equal (cadar entnow) higy (/ (cdr (assoc 40 (entget (cdr entnow)))) 4.0))
    67.                             (progn (setq rowlst (append rowlst (list entnow))))
    68.                             (progn (setq rowendlst (append rowendlst (list rowlst)))
    69.                                 (setq rowlst (list entnow))
    70.                                 (setq higy (cadar entnow))
    71.                             )
    72.                         )
    73.                         (setq n (+ n 1))
    74.                         (if (= n (length entmlst)) (setq rowendlst (append rowendlst (list rowlst))))
    75.                     )
    76.                     (command "_.UNDO" "be")
    77.                     (setq n 0 endlst nil)
    78.                     (repeat (length rowendlst)
    79.                         (setq endlst (vl-sort (nth n rowendlst) '(lambda (x y) (< (caar x) (caar y)))))
    80.                         (if (> (length endlst) 1)
    81.                             (progn
    82.                                 (setq startent_data (entget (cdr (car endlst))) i 1) 
    83.                                 (repeat (- (length endlst) 1)
    84.                                     (setq startent_data (subst (cons 1 (strcat (cdr (assoc 1 startent_data)) (cdr (assoc 1 (entget (cdr (nth i endlst))))))) (assoc 1 startent_data) startent_data))
    85.                                     (entmod startent_data)
    86.                                     (command "ERASE" (cdr (nth i endlst)) "")
    87.                                     (setq i (+ i 1))
    88.                                 )
    89.                             )
    90.                         )
    91.                         (setq n (1+ n))
    92.                     )
    93.                     (command "_.UNDO" "e")
    94.                 )
    95.             )
    96.         )
    97.     )
    98.     (prin1)
    99. )
    100. (princ "\n 同行文字合并 快捷键：FV ")
    101. (prin1)