[求助]：合并文本程序

szx025

;;;合并文本内容

(defun C:TJ (/ SS ENT STR I)
    (if        (and (setq SS (ssget '((0 . "*TEXT"))))
             (>= (sslength SS) 2)
        )
        (progn
            ;;获得第一个对象的内容
            (setq ENT (entget (ssname SS 0))
                  STR (cdr (assoc 1 ENT))
            )
            ;;获得其他对象的内容并依次连接
            (setq I 1)
            (repeat (1- (sslength SS))
                (setq STR (strcat STR
                                  (cdr (assoc 1 (entget (ssname SS I))))
                          )
                      I          (1+ I)
                )
            )
            ;;更新第一个对象内容
            (setq ENT
                     (subst (cons 1 STR)
                            (assoc 1 ENT)
                            ENT
                     )
            )
            (entmod ENT)
        )
    )
(command "_.erase" ss "remove" (ssname SS 0) "")
    (princ)
);_结束defun
;这是合并文本程序，请高手改进，加一选项，文本之间增加一空格

gysjy

将
(setq STR (strcat STR
(cdr (assoc 1 (entget (ssname SS I))))
)
改为：
(setq STR (strcat STR  " "
(cdr (assoc 1 (entget (ssname SS I))))
)

szx025

最好加一选项，1不加空格，2加空格

yinzhun22

有没有文本按空格拆分的lsp，位置，图层都不改变

gysjy

最初由 szx025 发布
[B]最好加一选项，1不加空格，2加空格 [/B]

2. 
   
3.   [FONT=courier new]
   
4. ;;;合并文本内容
   
5. 
   
6. (defun C:TJ (/ SS ENT STR I)
   
7. (if (and (setq SS (ssget '((0 . "*TEXT"))))
   
8. (>= (sslength SS) 2)
   
9. )
   
10. (progn
    
11. ;;获得第一个对象的内容
    
12. (setq p (getpoint "\n加空格（鼠标左键）/不加空格<鼠标右键>:"))
    
13. (if p (setq str1 " ")(setq str1 ""))
    
14. (setq ENT (entget (ssname SS 0))
    
15. STR (cdr (assoc 1 ENT))
    
16. )
    
17. ;;获得其他对象的内容并依次连接
    
18. (setq I 1)
    
19. (repeat (1- (sslength SS))
    
20. (setq STR (strcat STR str1
    
21. (cdr (assoc 1 (entget (ssname SS I))))
    
22. )
    
23. I (1+ I)
    
24. )
    
25. )
    
26. ;;更新第一个对象内容
    
27. (setq ENT
    
28. (subst (cons 1 STR)
    
29. (assoc 1 ENT)
    
30. ENT
    
31. )
    
32. )
    
33. (entmod ENT)
    
34. )
    
35. )
    
36. (command "_.erase" ss "remove" (ssname SS 0) "")
    
37. (princ)
    
38. );_结束defun
    
39. 
    
40.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;合并文本内容<br /> <br /> (defun C:TJ (/ SS ENT STR I)<br /> (if (and (setq SS (ssget '((0 . "*TEXT"))))<br /> (>= (sslength SS) 2)<br /> )<br /> (progn<br /> ;;获得第一个对象的内容<br /> (setq p (getpoint "\n加空格（鼠标左键）/不加空格<鼠标右键>:"))<br /> (if p (setq str1 " ")(setq str1 ""))<br /> (setq ENT (entget (ssname SS 0))<br /> STR (cdr (assoc 1 ENT))<br /> )<br /> ;;获得其他对象的内容并依次连接<br /> (setq I 1)<br /> (repeat (1- (sslength SS))<br /> (setq STR (strcat STR str1 <br /> (cdr (assoc 1 (entget (ssname SS I))))<br /> )<br /> I (1+ I)<br /> )<br /> )<br /> ;;更新第一个对象内容<br /> (setq ENT<br /> (subst (cons 1 STR)<br /> (assoc 1 ENT)<br /> ENT<br /> )<br /> )<br /> (entmod ENT)<br /> )<br /> )<br /> (command "_.erase" ss "remove" (ssname SS 0) "")<br /> (princ)<br /> );_结束defun<br /> <br />   [/FONT]<br />

w379106181

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享

fl502

合并文本的顺序，按照选择集的顺序。

sicky111

好程序。