那位有此程序不,能赐与在下不,

357785513 · 发表于 2012-10-30 14:31:39

那位有此程序不,能赐与在下不,在一聊天室里看到一图片如下,那位有这个程序不,能赐与在下不,将感激不尽

yzh898 · 发表于 2020-8-3 16:26:54

zyj0063 发表于 2012-11-1 07:10
文本连接lsp代码：声明：本代码为本人多年收集珍藏，并非原创。

谢谢分享。

myjping · 发表于 2012-10-30 15:21:43

去试试我的文字打断

shyshineboy · 发表于 2012-10-30 20:22:14

贱人工具箱5.7有这个功能
如果要源码就不知道了

357785513 · 发表于 2012-10-30 21:39:16

是吧,大家都找到了,我怎么一个也没有遇上呀

357785513 · 发表于 2012-10-31 23:22:54

找不到实在找不到,那位有类似的工具不,报个信也行呀

zyj0063 · 发表于 2012-11-1 07:10:03

本帖最后由 zyj0063 于 2012-11-1 07:20 编辑

文本连接lsp代码：

(defun c:str(/ sset1 ename1 elist1 str1 ename2 elist2 str2 nstr)
(setq sset1 (entsel (strcat "\n选择首文字段:"))
ename1 (car sset1)
elist1 (entget ename1)
str1 (cdr (assoc 1 elist1))
)
(redraw ename1 3)
(setq sset2 T)
(while sset2
(setq sset2 (entsel (strcat "\n选择尾文字段:")))
(if (null sset2)
(progn
(princ "程序结束")
(exit)
)
)
(setq ename2 (car sset2)
elist2 (entget ename2)
str2 (cdr (assoc 1 elist2))
nstr (strcat str1 str2)
)
(redraw ename1 4)
(entmod (append elist1 (list (cons 1 nstr))))
(command "_erase" ename2 "")
(setq ename1 (cdr (assoc -1 elist1))
elist1 (entget ename1)
str1 (cdr (assoc 1 elist1))
)
)
(princ)
);End Defun

(defun c:str(/ sset1 ename1 elist1 str1 ename2 elist2 str2 nstr)   
    (setq  sset1 (entsel (strcat "\n选择首文字段:")) 
          ename1 (car sset1) 
          elist1 (entget ename1) 
            str1 (cdr (assoc 1 elist1)) 
    ) 
    (redraw ename1 3) 
    (setq sset2 T) 
    (while sset2 
       (setq  sset2 (entsel (strcat "\n选择尾文字段:"))) 
         (if (null sset2) 
           (progn 
             (princ "程序结束") 
             (exit) 
           ) 
         ) 
       (setq ename2 (car sset2) 
             elist2 (entget ename2) 
               str2 (cdr (assoc 1 elist2)) 
               nstr (strcat str1 str2) 
       ) 
       (redraw ename1 4) 
       (entmod (append elist1 (list (cons 1 nstr)))) 
       (command "_erase" ename2 "") 
       (setq ename1 (cdr (assoc -1 elist1)) 
             elist1 (entget ename1) 
               str1 (cdr (assoc 1 elist1)) 
       ) 
    ) 
    (princ) 
 );End Defun

声明：本代码为本人多年收集珍藏，并非原创。

357785513 · 发表于 2012-11-1 12:55:04

无论如何,感谢先.谢谢谢谢

lingduwx · 发表于 2012-11-1 13:35:28

顶一个楼上兄弟
兄弟提供的可以连接文本，不过好像不能拆分啊，要是两个在一起就好了

langjs · 发表于 2012-11-1 15:54:58

本帖最后由 langjs 于 2012-11-6 12:28 编辑

正好有空，就做了一个，打断文字的

(princ  "\n  打断文字  by:langjs 命令:aa")
(defun c:aa (/ b box ent ent2 h i n name num pt pt10 str str1 str2)
  (while (and
         (setq pt (cadr (setq name (entsel "\n选择文字:"))))
         (setq ent (entget (car name)))
         (IF (= (cdr (assoc 0 ent)) "TEXT")
         (progn
            (setq str (cdr (assoc 1 ent)) pt10 (cdr (assoc 10 ent))  h (cdr (assoc 40 ent))
                  ent2 (cdr ent) box (textbox ent2)
                  n (fix (/ (- (car pt) (car pt10)) (/ (- (car (cadr box)) (car (car box))) (strlen str))))
                  num 0  i 1
            )
            (repeat n
               (if (> (ascii (substr str i i)) 160) (setq num (1+ num)) )
               (setq i (1+ i))
            )
            (if (= (rem num 2) 1) (setq n (1- n)))
            (setq str1 (substr str 1 n) str2 (substr str (1+ n)))
            (entmod (subst (cons 1 str1) (assoc 1 ent) ent ))
            (setq ent2 (subst(cons 1 str2)(assoc 1 ent2) ent2 ))
            (entmake (subst (cons 10 (list (car pt10) (- (cadr pt10) (* 1.4 h)))) (assoc 10 ent2) ent2))
         )
         nil
         )
      )
  )
  (princ)
)

(princ  "\n  文字合并  by:langjs 命令:qq")
(defun c:qq (/ ent name name2 str)
  (setq str "")
  (while (and
(setq name (car (entsel "\n选择文字:")))
(setq ent (entget name))
(wcmatch (cdr (assoc 0 ent)) "*TEXT")
  )
(if name2 (entdel name2))
(setq str (strcat str (cdr (assoc 1 ent))) name2 name )
(entmod (subst (cons 1 str) (assoc 1 ent)  ent ))
(redraw name 3)
  )
  (if name2 (redraw name2 4))
  (princ)
)

357785513 · 发表于 2012-11-2 12:28:03

各位才哥,感激不尽,啥都甭说了,谢谢

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

那位有此程序不,能赐与在下不,

本帖子中包含更多资源

点评

相关帖子

本帖子中包含更多资源