DS助力，AI按段落行合并文字

null.

用于天正T3文字中西文断裂的文字合并，不影响原有段落。

2. (defun c:TT3 (/ ss TextEntlist TextHigh TextEntlistNew currentEnt currentCenter otherEnt otherCenter dist mergedText)
   
3.     ; 步骤1: 用ssget选中TEXT文字集合，得到ss选择集
   
4.     (setq ss (ssget '((0 . "TEXT"))))
   
5.     (if ss
   
6.         (progn
   
7.             ; 步骤2: 构建实体列表并统计字高频率
   
8.             (setq TextEntlist '() freqTable '() maxCount 0 TextHigh 0)
   
9.             (repeat (setq i (sslength ss))
   
10.                 (setq ent (ssname ss (setq i (1- i))))
    
11.                 (setq entData (entget ent))
    
12.                 ; 提取基点、字高、文字内容
    
13.                 (setq pt (cdr (assoc 10 entData))
    
14.                       hgt (cdr (assoc 40 entData))
    
15.                       txt (cdr (assoc 1 entData)))
    
16.                 ; 更新字高频率表
    
17.                 (if (setq entry (assoc hgt freqTable))
    
18.                     (setq freqTable (subst (cons hgt (1+ (cdr entry))) entry freqTable))
    
19.                     (setq freqTable (cons (cons hgt 1) freqTable))
    
20.                 )
    
21.                 ; 构建排序列表
    
22.                 (setq TextEntlist (cons (list ent pt txt hgt) TextEntlist))
    
23.             )
    
24.             ; 确定最高频字高
    
25.             (foreach entry freqTable
    
26.                 (if (> (cdr entry) maxCount)
    
27.                     (setq maxCount (cdr entry) TextHigh (car entry))
    
28.                 )
    
29.             )
    
30.             (setq TextHigh (* TextHigh 0.7)) ; 缩小0.7倍
    
31.          
    
32.             ; 循环处理TextEntlist
    
33.             (while TextEntlist
    
34.                 (setq TextEntlistNew '())
    
35.                 (setq currentEnt (car TextEntlist))
    
36.                 (setq currentCenter (cadr currentEnt))
    
37.                 (setq TextEntlist (cdr TextEntlist))
    
38.                 (setq TextEntlistNew (cons currentEnt TextEntlistNew))
    
39. 
    
40.                 ; 步骤3: 比较中心点Y坐标距离
    
41.                 (foreach otherEnt TextEntlist
    
42.                     (setq otherCenter (cadr otherEnt))
    
43.                     (setq dist (abs (- (cadr currentCenter) (cadr otherCenter))))
    
44.                     (if (< dist TextHigh)
    
45.                         (progn
    
46.                             (setq TextEntlistNew (cons otherEnt TextEntlistNew))
    
47.                             (setq TextEntlist (vl-remove otherEnt TextEntlist))
    
48.                         )
    
49.                     )
    
50.                 )
    
51. 
    
52.                 ; 步骤4: 将TextEntlistNew按文字基点从左到右的文字连接图元文字
    
53.                 (setq TextEntlistNew (vl-sort TextEntlistNew '(lambda (a b) (< (car (cadr a)) (car (cadr b))))))
    
54.                 (setq mergedText "" currentobj nil)
    
55.                 (foreach ent TextEntlistNew
    
56.                   (if (null currentobj)(setq currentobj (vla-Copy  (<span style="background-color: rgb(255, 255, 255);">vlax-ename->vla-object</span> (car ent)))))
    
57.                     (setq mergedText (strcat mergedText (caddr ent)))
    
58.                 )
    
59. 
    
60.                 (foreach ent TextEntlistNew
    
61.                     (entdel (car ent))
    
62.                 )
    
63.               (vla-put-TextString currentobj   mergedText )
    
64. 
    
65.                 ; 合并后的文字
    
66.               (vla-put-TextString currentobj   mergedText )
    
67.                
    
68.             )
    
69.         )
    
70.     )
    
71.     (princ)
    
72. )

(defun c:TT3 (/ ss TextEntlist TextHigh TextEntlistNew currentEnt currentCenter otherEnt otherCenter dist mergedText)<br />     ; 步骤1: 用ssget选中TEXT文字集合，得到ss选择集<br />     (setq ss (ssget '((0 . "TEXT"))))<br />     (if ss<br />         (progn <br />             ; 步骤2: 构建实体列表并统计字高频率 <br />             (setq TextEntlist '() freqTable '() maxCount 0 TextHigh 0)<br />             (repeat (setq i (sslength ss))<br />                 (setq ent (ssname ss (setq i (1- i))))<br />                 (setq entData (entget ent))<br />                 ; 提取基点、字高、文字内容 <br />                 (setq pt (cdr (assoc 10 entData))<br />                       hgt (cdr (assoc 40 entData))<br />                       txt (cdr (assoc 1 entData)))<br />                 ; 更新字高频率表 <br />                 (if (setq entry (assoc hgt freqTable))<br />                     (setq freqTable (subst (cons hgt (1+ (cdr entry))) entry freqTable))<br />                     (setq freqTable (cons (cons hgt 1) freqTable))<br />                 )<br />                 ; 构建排序列表 <br />                 (setq TextEntlist (cons (list ent pt txt hgt) TextEntlist))<br />             )<br />             ; 确定最高频字高 <br />             (foreach entry freqTable <br />                 (if (> (cdr entry) maxCount)<br />                     (setq maxCount (cdr entry) TextHigh (car entry))<br />                 )<br />             )<br />             (setq TextHigh (* TextHigh 0.7)) ; 缩小0.7倍 <br />           <br />             ; 循环处理TextEntlist<br />             (while TextEntlist<br />                 (setq TextEntlistNew '())<br />                 (setq currentEnt (car TextEntlist))<br />                 (setq currentCenter (cadr currentEnt))<br />                 (setq TextEntlist (cdr TextEntlist))<br />                 (setq TextEntlistNew (cons currentEnt TextEntlistNew))<br /> <br />                 ; 步骤3: 比较中心点Y坐标距离<br />                 (foreach otherEnt TextEntlist<br />                     (setq otherCenter (cadr otherEnt))<br />                     (setq dist (abs (- (cadr currentCenter) (cadr otherCenter))))<br />                     (if (< dist TextHigh)<br />                         (progn<br />                             (setq TextEntlistNew (cons otherEnt TextEntlistNew))<br />                             (setq TextEntlist (vl-remove otherEnt TextEntlist)) <br />                         )<br />                     )<br />                 )<br /> <br />                 ; 步骤4: 将TextEntlistNew按文字基点从左到右的文字连接图元文字<br />                 (setq TextEntlistNew (vl-sort TextEntlistNew '(lambda (a b) (< (car (cadr a)) (car (cadr b))))))<br />                 (setq mergedText "" currentobj nil)<br />                 (foreach ent TextEntlistNew<br />                   (if (null currentobj)(setq currentobj (vla-Copy  (<span style="background-color: rgb(255, 255, 255);">vlax-ename->vla-object</span> (car ent)))))<br />                     (setq mergedText (strcat mergedText (caddr ent)))<br />                 )<br /> <br />                 (foreach ent TextEntlistNew<br />                     (entdel (car ent))<br />                 )<br />               (vla-put-TextString currentobj   mergedText )<br /> <br />                 ; 合并后的文字<br />               (vla-put-TextString currentobj   mergedText )<br />                <br />             )<br />         )<br />     )<br />     (princ)<br /> )

附件的内容和这个码是一样的。

null.

演示,一键按行转，这是天正的原始T3,断裂的文字，它的中文和西文的不是一个水平点，程序自动判断是本行，还是另外一行。

转前


转后

怕怕吓一跳

错误: no function definition: *EN2OBJ*
修正：把这个函数改成vlax-ename->vla-object

yjwht

我也做了一个断行合并，一次只能合并单行，一次性框选合并多行感觉很难，并且也很实用的功能，厉害

珍惜hh

如果是天正文字分解后，存在一些线段图元的，用给出的程序就无法在识别修复了，应该要修改下吧

怕怕吓一跳

如果有奖，另找到了一小小的bug,就是最后多了一个语句：
(vla-put-TextString currentobj   mergedText )

                ; 合并后的文字
              (vla-put-TextString currentobj   mergedText )

MZ_li

连个图都没有就收钱？

panliang9

用AI助力的程序将来肯定会越来越多！

hao3ren

ds满天飞啊

Qwer1243

这还挺方便的

lxl217114

来凑个热闹

wwkko

楼主给力！

珍惜hh

学习下是什么原理

怕怕吓一跳

学习一下ai