[字串处理系列三][编程申请]：能否给大家写个多行智能的字符串连接程序？

marting · 发表于 2002-7-31 23:31:44

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

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

×

我们同事的图经常是文字都是单个的，能否提供个“多行智能”的字符串连接程序？

那样处理说明就太惬意了，谢谢！

eachy · 发表于 2002-8-1 00:04:48

最初由 marting 发布
[B]我们同事的图经常是文字都是单个的，能否提供个“多行智能”的字符串连接程序？

那样处理说明就太惬意了，谢谢！ [/B]

好了。

;|
命令：txt_join
功能：窗选字体自动按由上至下，由左至右的顺序将字串合并
程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
LISP目录，自己加入到菜单里面就可以非常方便的使用了。
关于程序的建议请到“晓东CAD空间-编程申请”论坛
[url]http://www.xdcad.net/forum留言[/url]
|;
(defun c:txt_join (/ cutz1 ll l11 l1 pt_min mm l0 ss tb js strb e str
str0 pt p1
)
(xdrx_begin)
(xdrx_ucson)
(defun cutz1 (p)
(list (car p) (cadr p))
)
(princ "\n请选取要编辑的文字 <退出>: ")
(setq ss (ssget '((0 . "TEXT"))))
(xdrx_setsstodb ss 0)
(setq tb nil
strb nil
mm (* 3e-4 (getvar "viewsize"))
pt_min (getvar "extmin")
)
;;构造表(((x1 y1) "string1" "实体名1") ((x2 y2) "string2" "实体名2") ......)
(while (setq e (xdrx_getentdata 0))
(setq tb (append (list (list (cutz1 (xdrx_getentdxf 10))
(xdrx_getentdxf 1)
e
)
)
tb
)
)
)
;;构造ll 按y坐标((距离1 (x1 y1) (x2 y2)...)
;; (距离2 (x1 y1) (x2 y2) ....)
(foreach ll (mapcar 'car tb)
(setq ln (abs (xdrx_p2ldist ll pt_min (polar pt_min 0 1.0)))
l2 l1
)
(while (and (setq ll1 (car l2))
(not (equal ln (car ll1) mm))
)
(setq l2 (cdr l2))
)
;;将距离值近似的线段归入同一个子表内, 否则另开一个新的子表。
(setq l1 (if ll1
(subst (append ll1 (list ll)) ll1 l1)
(cons (list ln ll) l1)
)
)
)
;;y坐标降序
(setq l11 (mapcar 'cdr (reverse (apply 'xdrx_rlistsort2 l1))))
;;ll x升序
(while (setq l0 (car l11))
(setq ll (append ll (apply 'xdrx_rlistsort2 l0)))
(setq l11 (cdr l11))
)
;;取出第一个字串
(setq e (last (assoc (car ll) tb)))
(xdrx_setenttodb e)
(setq ss (ssdel e ss)
)
;;构造字串表("string" "string1" ......)
(setq js 0)
(repeat (length ll)
(setq str (cadr (assoc (nth js ll) tb)))
(setq strb (append (list str) strb))
(setq js (1+ js))
)
(setq strb (mapcar 'xdrx_string_trimleft strb))
(setq strb (mapcar 'xdrx_string_trimright strb))
(command "erase" ss "")
(setq str0 (apply 'strcat (reverse strb))) ;合并字串
(xdrx_modent 1 str0 10 (car ll))
(setq ss (ssadd e ss))
(setq pt (append (car ll) '(0)))
(if (setq
p1 (xdrx_dragssmove "\n请移动点<不移动>: " ss pt)
)
(command ".move" ss "" pt p1)
)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)
(princ)
(princ "\n字串合并, 命令C:txt_join.")
(princ)

;| 
   命令：txt_join 
    
   功能：窗选字体自动按由上至下，由左至右的顺序将字串合并 
 
        程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的 
        LISP目录，自己加入到菜单里面就可以非常方便的使用了。 
        关于程序的建议请到“晓东CAD空间-编程申请”论坛 
        [url]http://www.xdcad.net/forum留言[/url]          
    
|; 
(defun c:txt_join (/ cutz1 ll l11 l1 pt_min mm l0 ss tb        js strb        e str 
                   str0        pt p1 
                  ) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (defun cutz1 (p) 
    (list (car p) (cadr p)) 
  ) 
  (princ "\n请选取要编辑的文字 <退出>: ") 
  (setq ss (ssget '((0 . "TEXT")))) 
  (xdrx_setsstodb ss 0) 
  (setq        tb     nil 
        strb   nil 
        mm     (* 3e-4 (getvar "viewsize")) 
        pt_min (getvar "extmin") 
  ) 
  ;;构造表(((x1 y1) "string1" "实体名1") ((x2 y2) "string2" "实体名2") ......) 
  (while (setq e (xdrx_getentdata 0)) 
    (setq tb (append (list (list (cutz1 (xdrx_getentdxf 10)) 
                                 (xdrx_getentdxf 1) 
                                 e 
                           ) 
                     ) 
                     tb 
             ) 
    ) 
  ) 
  ;;构造ll 按y坐标((距离1 (x1 y1) (x2 y2)...) 
  ;;               (距离2 (x1 y1) (x2 y2) ....) 
  (foreach ll (mapcar 'car tb) 
    (setq ln (abs (xdrx_p2ldist ll pt_min (polar pt_min 0 1.0))) 
          l2 l1 
    ) 
    (while (and        (setq ll1 (car l2)) 
                (not (equal ln (car ll1) mm)) 
           ) 
      (setq l2 (cdr l2)) 
    ) 
    ;;将距离值近似的线段归入同一个子表内, 否则另开一个新的子表。 
    (setq l1 (if ll1 
               (subst (append ll1 (list ll)) ll1 l1) 
               (cons (list ln ll) l1) 
             ) 
    ) 
  ) 
  ;;y坐标降序 
  (setq l11 (mapcar 'cdr (reverse (apply 'xdrx_rlistsort2 l1)))) 
  ;;ll x升序 
  (while (setq l0 (car l11)) 
    (setq ll (append ll (apply 'xdrx_rlistsort2 l0))) 
    (setq l11 (cdr l11)) 
  ) 
  ;;取出第一个字串 
  (setq e (last (assoc (car ll) tb))) 
  (xdrx_setenttodb e) 
  (setq        ss (ssdel e ss) 
  ) 
  ;;构造字串表("string" "string1" ......) 
  (setq js 0) 
  (repeat (length ll) 
    (setq str (cadr (assoc (nth js ll) tb))) 
    (setq strb (append (list str) strb)) 
    (setq js (1+ js)) 
  ) 
  (setq strb (mapcar 'xdrx_string_trimleft strb)) 
  (setq strb (mapcar 'xdrx_string_trimright strb)) 
  (command "erase" ss "") 
  (setq str0 (apply 'strcat (reverse strb))) ;合并字串 
  (xdrx_modent 1 str0 10 (car ll)) 
  (setq ss (ssadd e ss)) 
  (setq pt (append (car ll) '(0))) 
  (if (setq 
        p1 (xdrx_dragssmove "\n请移动点<不移动>: " ss pt) 
      ) 
    (command ".move" ss "" pt p1) 
  ) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
) 
(princ) 
(princ "\n字串合并, 命令C:txt_join.") 
(princ)

sztjf · 发表于 2002-8-2 01:42:27

请问怎样加入到菜单里面

cy956 · 发表于 2002-8-5 13:57:12

送你一个r12版时用的程序。
当时用的是(command "sh" “edit"...),
后来改为用doslib调用notepad。
这样你可以随意调整各行文字。

(defun c:edc (/ DT E E0 EN EN0 FIL H0 IN LAY0 N P0 P1 S S0 ST TXT W0)
(prompt "\n选择要在notepad中编辑的文字:")
(mapcar 'setvar '("cmdecho""blipmode") '(0 0))
(setq s (ssget '((0 . "TEXT"))) in 0 n(sslength s)
fil "c:/000.txt" txt (open fil "w")
k-edc(acqs "\nYes or No 原文删否?" (if k-edc k-edc "Y"))
e0 (ssname s 0) en0(entget e0)
p0 (dxf 10 en0) h0 (dxf 40 en0)
s0(dxf 7 en0) w0(dxf 41 en0)
lay0(dxf 8 en0)
)
(if (= "Y" k-edc)
(repeat n
(setq e (ssname s in) en (entget e)
st (dxf 1 en) in (1+ in))
(princ (strcat st "\n" )txt)
(entdel e)
)
(repeat n
(setq e (ssname s in) en (entget e)
st (dxf 1 en) in (1+ in))
(princ (strcat st "\n" )txt)
)
)
(close txt)
(dos_shellexe "notepad.exe" fil)
(setq p1 (pri1 getpoint p0 "\n文字新起点:" p0)
txt(open fil "r"))
(while (setq dt(read-line txt))
(#M_TXT P1 dt s0 h0 w0 0 0 0 lay0 -1)
(setq p1(polar p1 (- a:pi2) (* 1.5 h0)))
)
(close txt)
(dos_delete "c:/000.txt")
(mapcar 'setvar '("cmdecho""blipmode" "osmode") '(1 1 32))(princ)
)
(defun #m_txt (pt txt sty th wid tan d72 d73 lay color /)
(if (and (= d72 0)(= d73 0))
(setq en000 (list
(cons 0 "TEXT")
(cons 1 txt)
(cons 7 sty)
(cons 8 lay)
(cons 10 pt)
(cons 40 th)
(cons 41 wid)
(cons 50 tan)
(cons 72 d72)
(cons 73 d73) ) )
(setq en000 (list
(cons 0 "TEXT")
(cons 1 txt)
(cons 7 sty)
(cons 8 lay)
(cons 10 pt)
(cons 11 pt)
(cons 40 th)
(cons 41 wid)
(cons 50 tan)
(cons 72 d72)
(cons 73 d73) ) )
)
(IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799)))))
(if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))
(if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.") )
)

(defun c:edc (/ DT E E0 EN EN0 FIL H0 IN LAY0 N P0 P1 S S0 ST TXT W0) 
  (prompt "\n选择要在notepad中编辑的文字:") 
  (mapcar 'setvar '("cmdecho""blipmode") '(0 0)) 
  (setq s (ssget '((0 . "TEXT"))) in 0 n(sslength s) 
          fil "c:/000.txt"  txt (open fil "w") 
        k-edc(acqs "\nYes or No 原文删否?" (if k-edc k-edc "Y")) 
        e0 (ssname s 0) en0(entget e0) 
        p0 (dxf 10 en0) h0 (dxf 40 en0) 
        s0(dxf 7 en0)  w0(dxf 41 en0) 
        lay0(dxf 8 en0) 
  ) 
  (if (= "Y" k-edc) 
    (repeat n 
      (setq e (ssname s in) en (entget e)        
            st (dxf 1 en)  in (1+ in)) 
      (princ (strcat st "\n" )txt) 
      (entdel e) 
    ) 
    (repeat n 
      (setq e (ssname s in) en (entget e)        
            st (dxf 1 en)  in (1+ in)) 
      (princ (strcat st "\n" )txt) 
    )    
  ) 
  (close txt) 
  (dos_shellexe "notepad.exe" fil) 
  (setq p1 (pri1 getpoint p0 "\n文字新起点:" p0) 
        txt(open fil "r")) 
  (while (setq dt(read-line txt)) 
    (#M_TXT P1 dt s0 h0 w0 0 0 0 lay0 -1) 
    (setq p1(polar p1 (- a:pi2) (* 1.5 h0))) 
  ) 
  (close txt) 
  (dos_delete "c:/000.txt") 
  (mapcar 'setvar '("cmdecho""blipmode" "osmode") '(1 1 32))(princ) 
) 
 
(defun #m_txt (pt txt sty th wid tan d72 d73 lay color /) 
 (if (and (= d72 0)(= d73 0)) 
  (setq en000 (list 
      (cons 0 "TEXT") 
      (cons 1 txt) 
      (cons 7 sty) 
      (cons 8 lay) 
      (cons 10 pt) 
      (cons 40 th) 
      (cons 41 wid) 
      (cons 50 tan) 
      (cons 72 d72) 
      (cons 73 d73)   ) ) 
  (setq en000 (list 
      (cons 0 "TEXT") 
      (cons 1 txt) 
      (cons 7 sty) 
      (cons 8 lay) 
      (cons 10 pt) 
      (cons 11 pt) 
      (cons 40 th) 
      (cons 41 wid) 
      (cons 50 tan) 
      (cons 72 d72) 
      (cons 73 d73)   ) ) 
  ) 
  (IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799))))) 
  (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color))))) 
  (if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.")  ) 
)

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

[字串处理系列三][编程申请]：能否给大家写个多行智能的字符串连接程序？

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

相关帖子

Re: [编程申请]：能否给大家写个多行智能的字符串连接程序？

浏览过的版块