批量选择文字粘贴为多行文字顺序排列问题？求解答
代码是明经的，感谢原作者
批量选择文字粘贴为多行文字，这个点选的时候顺序没问题，框选的时候没有排序，会错乱，能否实现按左到右，上到下顺序排列成多行呢？
;
(vl-load-com)
(defun x-clip-string (str / html result)
(and (= (type str) 'str)
(setq html (vlax-create-object "htmlfile"))
(setq result (vlax-invoke (vlax-get(vlax-get html 'parentwindow) 'clipboarddata )'setdata "text" str ))
(vlax-release-object html))
)
(defun c:w2()
(vl-load-com)
(setq txtcon (strcat))
(setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
(setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setq i 0)
(setq txtcon (strcat))
(repeat (vla-get-count ssv)
(setq txtcon (apply '(lambda (v) (setq txtcon (strcat txtconv "\n")))
(progn
(if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
(progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
(setq pt (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
(setq pt (vla-get-TextOverride (vla-item ssv i)) )))
(setq pt (vla-get-TextString (vla-item ssv i)))
)
(list pt)
)))
(setq i (1+ i))
)
(x-clip-string txtcon)
(princ "\n文字已复制到剪切板,可以直接粘贴了！")
(princ)
)
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=107489&highlight=%C5%C5%D0%F2
这里面写得很详细
排序 是要按 座標大小 還是 數字大小
文字串是長什麼樣子 請給個 測試圖檔 lee50310 发表于 2023-10-27 17:46
排序 是要按 座標大小 還是 數字大小
文字串是長什麼樣子 請給個 測試圖檔
1.无论如何框选都是从 左到右上到下的顺序
2.此程序生成的多行带一个多余空行，导致我在用你的指定图层多行转单行的时候，文字会下沉一小段距离，不知道能不能解决这个问题
本帖最后由 lee50310 于 2023-10-29 18:13 编辑
改好了執行指令:w3
1.選取文字
2.按鍵盤 ctrl-v 貼上 或 在螢幕按滑鼠右鍵 選擇貼上
;;
;;修改1.增加排序功能去
;;; 2.去除文字串最后换行字符 by lee50310 日期2023/10/28
;;----------------------------------------------------------------------
(vl-load-com)
(defun x-clip-string (str / html result txtcon)
(and (= (type str) 'str)
(setq html (vlax-create-object "htmlfile"))
(setq result (vlax-invoke (vlax-get(vlax-get html 'parentwindow) 'clipboarddata )'setdata "text" str ))
(vlax-release-object html))
)
;;----------------------------------------------------------------------
;;
;;<***** 主程式 *****>
;;
(defun c:w3( / txtsstxtcon st)
(vl-load-com)
(setq txtss (ssget '((0 . "*TEXT,DIMENSION"))))
(command "_.copyclip" "Previous" "") ;(剪贴复制)上次的选择集
(setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setq i 0 sel nil wel nil)
(repeat (vla-get-count ssv)
(setq sel (apply '(lambda (v) (setq sel (cons v sel))) ;将文字选集对象 转 文字列表sel
(progn
(if (= (vla-get-ObjectName (vla-item ssv i)) "AcDbRotatedDimension")
(progn (if (= (vla-get-TextOverride (vla-item ssv i)) "")
(setq st (rtos (vla-get-Measurement (vla-item ssv i)) 2 2))
(setq st (vla-get-TextOverride (vla-item ssv i)) ))
);end_progn
(setq st (vla-get-TextString (vla-item ssv i))) ;
)
(list st)
);end_progn
);end_apply
);end_setq
(setq i (1+ i))
);end_repeat
(setq txtcon (strcat))
(setq wel(vl-sort sel '(lambda (x1 x2) (< (atoi x1) (atoi x2))))) ;数字排序由小到大
(foreach x wel (setq txtcon (strcat txtconx "\n")) ) ;文字列表 转 单一字串
(setq wel(list(vl-string-right-trim "\n" (car wel)))) ;去除文字串最后换行字符
(x-clip-string txtcon)
(princ "\n文字已覆制到剪切板,可以直接粘贴了！")
)
;;----------------------------------------------------------------------
lee50310 发表于 2023-10-28 04:36
改好了執行指令:w3
1.選取文字
2.按鍵盤 ctrl-v...
感谢老哥，不过还是有点问题
1.生成的多行文字会多一行这个能去掉这一行多余么
2.现在是按大小排序，但是当我的单行文字如左边这样时，排出来有bug，能否生成的多行和左边是一样的，详见下图，能否改为无论怎么框选按xy那样，从左往右，从上往下排列，因为多数场景我们就是需要复制一大部分文字同时不打乱顺序变成多行
测试图............... 本帖最后由 lee50310 于 2023-10-28 18:33 编辑
muai2010 发表于 2023-10-28 09:54
感谢老哥，不过还是有点问题
1.生成的多行文字会多一行这个能去掉这一行多余么
只能幫你把字串最後換行符號去掉 (請重新下載 w3b_chs.lsp)
其他編排沒法做到
一举取得文字排序，很方便也很实用，感谢，收藏先！
页:
[1]