求一段LSP代码

hydkot99 · 发表于 2007-10-29 13:45:00

请帮忙用LISP写段代码,可以把依次从屏幕上选取的三段文字合并成一段,并可选择合并后文字的放置位置

leeyuan · 发表于 2007-10-29 20:31:00

提取文字内容后，用strcat合并，文字放置位置需提供更具体的条件才行，也可用pause 自定义

xgr · 发表于 2007-10-30 06:18:00

把刚才发的程序改动一下就可以了。

(defun c:wzbz (/ oldosmode pt1 te_1 te_2
obj_number_list tename txtlist e1
e2 n texthb pthb ent
ent1 tetbox tc col textpt1
textpt3 plin_p1 plin_p3 rectang_point_list
)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\n文字合并")
(while (setq pt1 (getpoint "\n请框选文字对象-->"))
(setq pt2 (getcorner pt1 "\n请框选文字对象-->"))
(setq te_1 (ssget "c" pt1 pt2 '((0 . "TEXT"))))
(setq te_2 (ssget "c" pt1 pt2 '((0 . "MTEXT"))))
;;合并选择集
(if (/= te_2 nil)
(while (setq mtextname (ssname te_2 0))
(setq te_1 (ssadd mtextname te_1))
(setq te_2 (ssdel mtextname te_2))
)
)
;;生成一表，对象按X坐标由大到小排列
(setq obj_number_list '())
(while (setq tename (ssname te_1 0))
(setq txtpoint (cdr (assoc 10 (entget tename))))
;;构造点坐标文字名称表
(setq txtlist (cons txtpoint tename))
(setq obj_number_list (cons txtlist obj_number_list))
(setq te_1 (ssdel tename te_1))
)
;;对obj_number_list按X坐标由小到大排序
(setq obj_number_list
(vl-sort obj_number_list
(function (lambda (e1 e2)
(> (caar e1) (caar e2))
)
)
)
)
;;循环取表元素，合并文字
(setq n 0
texthb ""
)
(repeat (length obj_number_list)
(setq texthb
(strcat
(cdr (assoc 1 (entget (cdr (nth n obj_number_list)))))
texthb
)
)
(setq n (1+ n))
)
;;取第一文字坐标
(setq pthb (caar (reverse obj_number_list)))
;;删除其它文字
(setq obj_number_list1 (cdr (reverse obj_number_list)))
(foreach n obj_number_list1
(command "erase" (cdr n) "")
)
;;修改第一个文字
(setq ent (cdar (reverse obj_number_list)))
(setq ent1 (entget ent))
(setq ent1 (subst (cons 1 texthb) (assoc 1 ent1) ent1))
(entmod ent1)
(command "move" (entlast) "" pthb pause)
)
(PRINC)
)

(defun c:wzbz (/   oldosmode  pt1 te_1    te_2
        obj_number_list      tename txtlist    e1
        e2   n      texthb pthb    ent
        ent1   tetbox     tc  col    textpt1
        textpt3   plin_p1    plin_p3 rectang_point_list
       )
  (setq oldosmode (getvar "osmode"))
  (setvar "osmode" 0)
  (prompt "\n文字合并")
  (while (setq pt1 (getpoint "\n请框选文字对象-->"))
    (setq pt2 (getcorner pt1 "\n请框选文字对象-->"))
    (setq te_1 (ssget "c" pt1 pt2 '((0 . "TEXT"))))
    (setq te_2 (ssget "c" pt1 pt2 '((0 . "MTEXT"))))
    ;;合并选择集
    (if (/= te_2 nil)
      (while (setq mtextname (ssname te_2 0))
 (setq te_1 (ssadd mtextname te_1))
 (setq te_2 (ssdel mtextname te_2))
      )
    )
    ;;生成一表，对象按X坐标由大到小排列
    (setq obj_number_list '())
    (while (setq tename (ssname te_1 0))
      (setq txtpoint (cdr (assoc 10 (entget tename))))
      ;;构造点坐标文字名称表
      (setq txtlist (cons txtpoint tename))
      (setq obj_number_list (cons txtlist obj_number_list))
      (setq te_1 (ssdel tename te_1))
    )
    ;;对obj_number_list按X坐标由小到大排序
    (setq obj_number_list
    (vl-sort obj_number_list
      (function (lambda (e1 e2)
    (> (caar e1) (caar e2))
         )
      )
    )
    )
    ;;循环取表元素，合并文字
    (setq n 0
   texthb ""
    )
    (repeat (length obj_number_list)
      (setq texthb
      (strcat
        (cdr (assoc 1 (entget (cdr (nth n obj_number_list)))))
        texthb
      )
      )
      (setq n (1+ n))
    )
    ;;取第一文字坐标
    (setq pthb (caar (reverse obj_number_list)))
    ;;删除其它文字
    (setq obj_number_list1 (cdr (reverse obj_number_list)))
    (foreach n obj_number_list1
      (command "erase" (cdr n) "")
    )
    ;;修改第一个文字
    (setq ent (cdar (reverse obj_number_list)))
    (setq ent1 (entget ent))
    (setq ent1 (subst (cons 1 texthb) (assoc 1 ent1) ent1))
    (entmod ent1)
    (command "move" (entlast) "" pthb pause)
  )
  (PRINC)
)

icoloe · 发表于 2007-10-31 08:55:00

en,xuexi

liplum · 发表于 2007-11-1 01:05:00

这段代码我试了几次，好像只能对于同是单行文字的才好用，能不能把它修改为既能合并多行文字，又能合并单行文字，也能单、多行文字混合合并，合并后为多行文字。请指教

flytoday · 发表于 2012-1-16 19:18:25

这个不错但是竖向文字不行

清风明月名字 · 发表于 2012-5-18 18:48:19

谢谢3楼楼主，学习了

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