[求助]：求文字按行批量逐行合并的程序

chdragon · 发表于 2006-3-21 19:27:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

哪个高手懂得，麻烦告知，谢谢

xyp1964 · 发表于 2006-3-22 22:32:00

最初由 chdragon 发布
[B]

文本编辑工具20051117
Chtts.VLX

刚刚试过，是连成一段了得

你的程序不是每行一段，?.. [/B]

[FONT=courier new](load "xyp_lib.vlx") ;版本 V.20060314
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib.vlx")
■2·在每个程序内增加(load"xyp_lib.vlx")
■3·在command下，输入(load"xyp_lib.vlx")
■4·在菜单.mnl中增加(load"xyp_lib.vlx")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
|;
;;;文本合并
(defun c:wbhb ()
(Cmdla0)
(if (null kw)
(setq kw "2")
)
(setq kw (UKWORD 7
"1 2 3"
"\n合并顺序 : 1-选择先后/2-X坐标/3-Y坐标"
kw
)
)
(cond ((= kw "1")
(princ "\n按选择顺序合并文本，保留和更改第一文本!")
(wbhb-01)
)
((= kw "2")
(princ
"\n按选择文本的X坐标顺序合并文本，保留和更改最左侧文本!"
)
(wbhb-02)
)
((= kw "3")
(princ
"\n按选择文本的Y坐标顺序合并文本，保留和更改最上方文本!"
)
(wbhb-02)
)
)
(Cmdla1)
)
;;;按选择顺序合并，保留和更改第一文本
(DEFUN wbhb-01 ()
(if (SETQ ss (ssget '((0 . "TEXT")))
i -1
)
(progn
(setq s0 (ssname ss (setq i (1+ i)))
tx-s1 (dxf 1 (entget s0))
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq tx1 (dxf 1 (entget s1))
tx-s1 (STRCAT tx-s1 TX1)
)
(entdel s1)
)
(sub_upd s0 1 tx-s1)
)
)
)
;;;按选择文本的X或Y坐标顺序合并文本!
(defun wbhb-02 ()
(while (not (SETQ SS (ssget '((0 . "TEXT"))))))
(setq i -1
leng (sslength ss)
lst '()
)
(repeat leng
(setq s1 (ssname SS (setq i (1+ i)))
pt (dxf 10 (entget s1))
tx (dxf -1 (entget s1))
pt-tx (cons pt tx)
lst (cons pt-tx lst)
)
(fangshi)
)
(setq s0 (cdr (car lst))
tx-s1 (dxf 1 (entget s0))
lst (cdr lst)
)
(while (setq s1 (cdr (car lst)))
(setq tx1 (dxf 1 (entget s1))
tx-s1 (STRCAT tx-s1 TX1)
lst (cdr lst)
)
(entdel s1)
)
(sub_upd s0 1 tx-s1)
)
;;;排序方式
(defun fangshi ()
(cond ((= kw "2")
(setq lst
(vl-sort
lst
(function (lambda (e1 e2) (< (car (car e1)) (car (car e2))))
)
)
)
)
((= kw "3")
(setq
lst (vl-sort
lst
(function
(lambda (e1 e2) (> (cadr (car e1)) (cadr (car e2))))
)
)
)
)
)
)[/FONT]

[FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060314 
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下) 
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： 
★1·在acad.lsp中增加(load"xyp_lib.vlx") 
■2·在每个程序内增加(load"xyp_lib.vlx") 
■3·在command下，输入(load"xyp_lib.vlx") 
■4·在菜单.mnl中增加(load"xyp_lib.vlx") 
■5·将xyp_lib.vlx文件直接拽到cad屏幕 
[COLOR=red] ★通用函数下载地址：[/COLOR] 
[url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url] 
|; 
 
;;;文本合并 
(defun c:wbhb () 
  (Cmdla0) 
  (if (null kw) 
    (setq kw "2") 
  ) 
  (setq        kw (UKWORD 7 
                   "1 2 3" 
                   "\n合并顺序 : 1-选择先后/2-X坐标/3-Y坐标" 
                   kw 
           ) 
  ) 
  (cond        ((= kw "1") 
         (princ "\n按选择顺序合并文本，保留和更改第一文本!") 
         (wbhb-01) 
        ) 
        ((= kw "2") 
         (princ 
           "\n按选择文本的X坐标顺序合并文本，保留和更改最左侧文本!" 
         ) 
         (wbhb-02) 
        ) 
        ((= kw "3") 
         (princ 
           "\n按选择文本的Y坐标顺序合并文本，保留和更改最上方文本!" 
         ) 
         (wbhb-02) 
        ) 
  ) 
  (Cmdla1) 
) 
 
;;;按选择顺序合并，保留和更改第一文本 
(DEFUN wbhb-01 () 
  (if (SETQ ss (ssget '((0 . "TEXT"))) 
            i  -1 
      ) 
    (progn 
      (setq s0          (ssname ss (setq i (1+ i))) 
            tx-s1 (dxf 1 (entget s0)) 
      ) 
      (while (setq s1 (ssname ss (setq i (1+ i)))) 
        (setq tx1   (dxf 1 (entget s1)) 
              tx-s1 (STRCAT tx-s1 TX1) 
        ) 
        (entdel s1) 
      ) 
      (sub_upd s0 1 tx-s1) 
    ) 
  ) 
) 
 
;;;按选择文本的X或Y坐标顺序合并文本! 
(defun wbhb-02 () 
  (while (not (SETQ SS (ssget '((0 . "TEXT")))))) 
  (setq        i    -1 
        leng (sslength ss) 
        lst  '() 
  ) 
  (repeat leng 
    (setq s1        (ssname SS (setq i (1+ i))) 
          pt        (dxf 10 (entget s1)) 
          tx        (dxf -1 (entget s1)) 
          pt-tx        (cons pt tx) 
          lst        (cons pt-tx lst) 
    ) 
    (fangshi) 
  ) 
  (setq        s0    (cdr (car lst)) 
        tx-s1 (dxf 1 (entget s0)) 
        lst   (cdr lst) 
  ) 
  (while (setq s1 (cdr (car lst))) 
    (setq tx1        (dxf 1 (entget s1)) 
          tx-s1        (STRCAT tx-s1 TX1) 
          lst        (cdr lst) 
    ) 
    (entdel s1) 
  ) 
  (sub_upd s0 1 tx-s1) 
) 
 
;;;排序方式 
(defun fangshi () 
  (cond        ((= kw "2") 
         (setq lst 
                (vl-sort 
                  lst 
                  (function (lambda (e1 e2) (< (car (car e1)) (car (car e2)))) 
                  ) 
                ) 
         ) 
        ) 
        ((= kw "3") 
         (setq 
           lst (vl-sort 
                 lst 
                 (function 
                   (lambda (e1 e2) (> (cadr (car e1)) (cadr (car e2)))) 
                 ) 
               ) 
         ) 
        ) 
  ) 
)[/FONT]

xyp1964 · 发表于 2006-3-21 20:45:11

试试签名栏下的“文本编辑套件”程序之WBHB“文本合并”

doubao · 发表于 2006-3-21 21:01:58

autocad 的 express tools 里就有 text 转 mtext 的程序

chdragon · 发表于 2006-3-22 18:58:07

最初由 xyp1964 发布
[B]试试签名栏下的“文本编辑套件”程序之WBHB“文本合并” [/B]

你的wbbj程序只能合并为一个大段，我想要的是同一水平线的文字合并，并不是所有的都合成一段啊

xyp1964 · 发表于 2006-3-22 21:08:33

最初由 chdragon 发布
[B]

你的wbbj程序只能合并为一个大段，我想要的是同一水平线的文字合并，并不是所有的都合成一段啊 [/B]

可以根据用户要求选择：
合并顺序 : 1-选择先后/2-X坐标/3-Y坐标<2>:

chdragon · 发表于 2006-3-22 22:02:40

最初由 xyp1964 发布
[B]
可以根据用户要求选择：
合并顺序 : 1-选择先后/2-X坐标/... [/B]

文本编辑工具20051117
Chtts.VLX

刚刚试过，是连成一段了得

你的程序不是每行一段，而是所有的行集成一段了啊

我要的是每行里的合并即可，不是所有行集到一起

qq1254582201 · 发表于 2017-6-7 11:44:20

xyp1964 发表于 2006-3-22 22:32

这个lisp编的很到位，一般合并的是凌乱的说明文字，需要给规整成一段文字，方便编辑，基本上是实现在原位合并成一整段文字，文字的先后左右位置不变，正常情况是先X方向合并，然后在Y方向再合并。

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：求文字按行批量逐行合并的程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子