批量选择文字粘贴为多行文字顺序排列问题？求解答

muai2010

代码是明经的，感谢原作者
批量选择文字粘贴为多行文字，这个点选的时候顺序没问题，框选的时候没有排序，会错乱，能否实现按左到右，上到下顺序排列成多行呢？

1. ;
   
2. (vl-load-com)
   
3. (defun x-clip-string (str / html result)
   
4.   (and (= (type str) 'str)
   
5.     (setq html (vlax-create-object "htmlfile"))
   
6.     (setq result (vlax-invoke   (vlax-get  (vlax-get html 'parentwindow)   'clipboarddata )  'setdata   "text"   str ))
   
7.     (vlax-release-object html))
   
8. )
   
9. 
   
10. (defun c:w2()
    
11. (vl-load-com)
    
12.   (setq txtcon (strcat))
    
13.      (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
    
14.      (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
    
15.   (setq i 0)
    
16.   (setq txtcon (strcat))
    
17.   (repeat (vla-get-count ssv)
    
18.             (setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtcon  v "\n")))
    
19.                          (progn
    
20.                            (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
    
21.                                (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
    
22.                                       (setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
    
23.                                       (setq pt (vla-get-TextOverride (vla-item ssv i)) )))
    
24.                                (setq pt (vla-get-TextString (vla-item ssv i)))
    
25.                            )
    
26.                             (list pt)
    
27.                           )))
    
28.             (setq i (1+ i))
    
29.             )
    
30.   (x-clip-string txtcon)
    
31.   (princ "\n文字已复制到剪切板,可以直接粘贴了！")
    
32. (princ)
    
33. )
    

;<br /> (vl-load-com)<br /> (defun x-clip-string (str / html result)<br />   (and (= (type str) 'str)<br />     (setq html (vlax-create-object "htmlfile"))<br />     (setq result (vlax-invoke   (vlax-get  (vlax-get html 'parentwindow)   'clipboarddata )  'setdata   "text"   str ))<br />     (vlax-release-object html))<br /> )<br /> <br /> (defun c:w2()<br /> (vl-load-com)<br />   (setq txtcon (strcat))<br />      (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))<br />      (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))<br />   (setq i 0)<br />   (setq txtcon (strcat))<br />   (repeat (vla-get-count ssv)<br />             (setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtcon  v "\n")))<br />                          (progn<br />                            (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")<br />                                (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")<br />                                       (setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))<br />                                       (setq pt (vla-get-TextOverride (vla-item ssv i)) )))<br />                                (setq pt (vla-get-TextString (vla-item ssv i)))<br />                            )<br />                             (list pt)<br />                           )))<br />             (setq i (1+ i))<br />             )<br />   (x-clip-string txtcon)<br />   (princ "\n文字已复制到剪切板,可以直接粘贴了！")<br /> (princ)<br /> )<br />

飞雪神光

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=107489&highlight=%C5%C5%D0%F2

这里面写得很详细

lee50310

排序 是要按 座標大小 還是 數字大小  
文字串是長什麼樣子 請給個 測試圖檔

muai2010

lee50310 发表于 2023-10-27 17:46
排序 是要按 座標大小 還是 數字大小  
文字串是長什麼樣子 請給個 測試圖檔

1.无论如何框选都是从   左到右  上到下的顺序

2.此程序生成的多行带一个多余空行，导致我在用你的指定图层多行转单行的时候，文字会下沉一小段距离，不知道能不能解决这个问题

lee50310

改好了  執行指令:w3
                         1.選取文字
                         2.按鍵盤 ctrl-v 貼上 或 在螢幕按滑鼠右鍵 選擇貼上

2. ;;
   
3. ;;修改  1.增加排序功能去
   
4. ;;;    2.去除文字串最后换行字符   by lee50310 日期2023/10/28
   
5. ;;----------------------------------------------------------------------
   
6. (vl-load-com)
   
7. (defun x-clip-string (str / html result txtcon)
   
8.   (and (= (type str) 'str)
   
9.     (setq html (vlax-create-object "htmlfile"))
   
10.     (setq result (vlax-invoke   (vlax-get  (vlax-get html 'parentwindow)   'clipboarddata )  'setdata   "text"   str ))
    
11.     (vlax-release-object html))
    
12. )
    
13. 
    
14. ;;----------------------------------------------------------------------
    
15. ;;
    
16. ;;<***** 主程式 *****>
    
17. ;;
    
18. (defun c:w3( / txtss  txtcon st)
    
19. (vl-load-com)
    
20.      (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
    
21.          (command "_.copyclip" "Previous" "")                          ;(剪贴复制)上次的选择集
    
22.      (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
    
23. 
    
24.   (setq i 0 sel nil wel nil)
    
25.   (repeat (vla-get-count ssv)           
    
26.                 (setq sel (apply '(lambda (v) (setq sel (cons v sel))) ;将文字选集对象 转 文字列表sel
    
27.                          (progn
    
28.                            (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
    
29.                                (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
    
30.                                       (setq st (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
    
31.                                       (setq st (vla-get-TextOverride (vla-item ssv i)) ))
    
32.                                                                 );end_progn
    
33.                                (setq st (vla-get-TextString (vla-item ssv i))) ;
    
34.                            )
    
35.                             (list st)
    
36.                           );end_progn
    
37.                                                   );end_apply
    
38.                         );end_setq
    
39.                          (setq i (1+ i))
    
40.   );end_repeat
    
41.   (setq txtcon (strcat))               
    
42.   (setq wel(vl-sort sel '(lambda (x1 x2) (< (atoi x1) (atoi x2))))) ;数字排序由小到大
    
43.   (foreach x wel (setq txtcon (strcat txtcon  x "\n")) )            ;文字列表 转 单一字串
    
44.   (setq wel(list(vl-string-right-trim "\n" (car wel))))             ;去除文字串最后换行字符
    
45.                
    
46.   (x-clip-string txtcon)
    
47.   (princ "\n文字已覆制到剪切板,可以直接粘贴了！")
    
48. )
    
49. ;;----------------------------------------------------------------------

;; <br /> ;;修改  1.增加排序功能去 <br /> ;;;    2.去除文字串最后换行字符   by lee50310 日期2023/10/28<br /> ;;---------------------------------------------------------------------- <br /> (vl-load-com)<br /> (defun x-clip-string (str / html result txtcon)<br />   (and (= (type str) 'str)<br />     (setq html (vlax-create-object "htmlfile"))<br />     (setq result (vlax-invoke   (vlax-get  (vlax-get html 'parentwindow)   'clipboarddata )  'setdata   "text"   str ))<br />     (vlax-release-object html))<br /> )<br /> <br /> ;;----------------------------------------------------------------------<br /> ;;<br /> ;;<***** 主程式 *****><br /> ;;<br /> (defun c:w3( / txtss  txtcon st)<br /> (vl-load-com)<br />      (setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))<br />          (command "_.copyclip" "Previous" "")                          ;(剪贴复制)上次的选择集<br />      (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))<br /> <br />   (setq i 0 sel nil wel nil)<br />   (repeat (vla-get-count ssv)           <br />                 (setq sel (apply '(lambda (v) (setq sel (cons v sel))) ;将文字选集对象 转 文字列表sel<br />                          (progn<br />                            (if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")<br />                                (progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")<br />                                       (setq st (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))<br />                                       (setq st (vla-get-TextOverride (vla-item ssv i)) ))<br />                                                                 );end_progn<br />                                (setq st (vla-get-TextString (vla-item ssv i))) ;<br />                            )<br />                             (list st)<br />                           );end_progn<br />                                                   );end_apply<br />                         );end_setq<br />                          (setq i (1+ i))<br />   );end_repeat<br />   (setq txtcon (strcat))                <br />   (setq wel(vl-sort sel '(lambda (x1 x2) (< (atoi x1) (atoi x2))))) ;数字排序由小到大<br />   (foreach x wel (setq txtcon (strcat txtcon  x "\n")) )            ;文字列表 转 单一字串<br />   (setq wel(list(vl-string-right-trim "\n" (car wel))))             ;去除文字串最后换行字符<br />                 <br />   (x-clip-string txtcon)<br />   (princ "\n文字已覆制到剪切板,可以直接粘贴了！")<br /> )<br /> ;;----------------------------------------------------------------------

muai2010

lee50310 发表于 2023-10-28 04:36
改好了  執行指令:w3
                         1.選取文字
                         2.按鍵盤 ctrl-v  ...

感谢老哥，不过还是有点问题

1.生成的多行文字会多一行这个能去掉这一行多余么

2.现在是按大小排序，但是当我的单行文字如左边这样时，排出来有bug，能否生成的多行和左边是一样的，详见下图，能否改为无论怎么框选按xy那样，从左往右，从上往下排列，因为多数场景我们就是需要复制一大部分文字同时不打乱顺序变成多行

muai2010

测试图...............

lee50310

muai2010 发表于 2023-10-28 09:54
感谢老哥，不过还是有点问题

1.生成的多行文字会多一行这个能去掉这一行多余么

只能幫你把字串最後換行符號去掉 (請重新下載 w3b_chs.lsp)
其他編排沒法做到

xyp1964

jkop

一举取得文字排序，很方便也很实用，感谢，收藏先！