设为首页
收藏本站
登录
|
[加入论坛]
开启辅助访问
切换到窄版
站内搜索
首页
BBS
化工技术网- 赠人玫瑰 手有余香
»
首页
›
≡供配电、输发电、自控、公用、制图专区≡
›
『 化工制图 』
›
非常好用的关于文本的lsp
返回列表
查看:
1835
|
回复:
1
非常好用的关于文本的lsp
[复制链接]
2443725
当前离线
狗仔卡
2443725
发表于 2004-5-30 15:27
|
显示全部楼层
|
阅读模式
<
>TTA 可以将独立的dtext文本连接成一组文本
TTB 可以将一组文本分解成单个文字</P>
<P>;Jion 2 text strings
(defun c:TTA (/ en1 en2 enn st1 st2 stnew)
(setvar "cmdecho" 0)
(prompt "\n***select 1st text string: ")
(setq en1 (entget (car (entsel))))
(if (= "TEXT" (cdr (assoc 0 en1))) (progn
(prompt "\n***select 2nd text string: ")
(setq en2 (entget (car (entsel))))
(if (= "TEXT" (cdr (assoc 0 en2))) (progn
(setq st1 (assoc 1 en1))
(setq st2 (assoc 1 en2))
(setq stnew (strcat (cdr st2) (cdr st1)))
(setq enn en2)
(setq enn (subst (cons 1 stnew) st2 enn))
(entmod enn)
(if (/= en1 en2) (entdel (cdr (car en1))))
)(princ "Select a text please."))
)(princ "Select a text please."))
(princ)
)</P>
<P>
;Break a text string
(defun c:TTB(/ en1 ang height str len ch index pos strnew entnew strold )
(setvar "cmdecho" 0)
(setvar "aunits" 3)
(prompt "\n***select a text string: ")
(setq en1 (entget (car (entsel))))
(if (= "TEXT" (cdr (assoc 0 en1))) (progn
(setq height (cdr (assoc 40 en1)))
(setq ang (cdr (assoc 50 en1)))
(setq str (cdr (assoc 1 en1)))
(setq len (strlen str))
(setq en1 (subst (cons 1 "") (assoc 1 en1) en1))
(entmod en1)
(command "_.UCS" "world")
(command "_.UCS" "z" ang)
(setvar "blipmode" 0)
(setq index 1 pos 1)
(while (<= index len)
(setq ch (substr str index 1))
(if (> (ascii ch) 127) (progn
(setq strnew (substr str index 2))
(command "_.COPY" (cdr (car en1)) ""
(list 0 0) (list (* pos height) 0))
(setq entnew (entget (entlast)))
(setq strold (assoc 1 entnew))
(setq entnew (subst (cons 1 strnew) strold entnew))
(entmod entnew)
(setq index (+ index 2))
)(progn
(setq strnew (substr str index 1))
(command "_.COPY" (cdr (car en1)) ""
(list 0 0) (list (* pos height) 0))
(setq entnew (entget (entlast)))
(setq strold (assoc 1 entnew))
(setq entnew (subst (cons 1 strnew) strold entnew))
(entmod entnew)
(setq index (1+ index))
))
(setq pos (1+ pos))
)
(command "_.UCS" "p")
(command "_.UCS" "p")
(setvar "blipmode" 1)
(entdel (cdr (car en1)))
)(princ "Select a text please."))
(setvar "aunits" 0)
(princ)
)
</P>
本帖子中包含更多资源
您需要
登录
才可以下载或查看,没有账号?
[加入论坛]
x
回复
使用道具
举报
提升卡
置顶卡
沉默卡
变色卡
koalabear
当前离线
狗仔卡
koalabear
发表于 2004-5-30 17:04
|
显示全部楼层
不知有什么实用价值,楼主能介绍一下吗?
回复
支持
反对
使用道具
举报
返回列表
高级模式
B
Color
Image
Link
Quote
Code
Smilies
您需要登录后才可以回帖
登录
|
[加入论坛]
本版积分规则
发表回复
回帖后跳转到最后一页
化工技术网- 赠人玫瑰 手有余香
(
苏ICP备14035884号
)
快速回复
返回顶部
返回列表