http://bbs.xdcad.net/thread-643906-1-1.html-----------------------------程序代码--------------------------------------------
;这个lisp程序的作用是,将单行文本转换为多行文本,为多行文本设置背景遮罩
;背景遮罩边界偏移因子为1.1,使用图形背景颜色填充。
;s1选择集名称,i m n 计数器,addlist增加的组码
;entname 图元名,nlist 图元数据,tid 图元标志(若为TEXT则表示为单行文本),tt 文本,th文本高度
;pt 文本基点,tang 文本旋转角度,ttlen 文本大致长度,tstr 相对坐标形式的多行文本的另一点
(defun c:bg()
;首先要对图形进行一些设置,否则将会影响程序的使用。在程序结束前将会恢复这些设置!
(setq sysosnap (getvar "OSMODE")) ;取得对象捕捉设置
(setvar "OSMODE" 16384) ;关闭对象捕捉
(setq sysang (getvar "ANGDIR")) ;取得角度方向(顺时针/逆时针)
(setvar "ANGDIR" 0) ;设置为逆时针方向
(setq sysabase (getvar "ANGBASE")) ;取得方向的基准角度
(setvar "ANGBASE" 0) ;设置方向的基准角度为东
(command "ucs" "") ;设置为wcs
(setq s1 (ssget)) ;选取单行文本或多行文本,构造非空选择集
(if (/= s1 nil) (print) ;构造选择集成功,继续
(progn ;构造失败,恢复设置退出
(setvar "OSMODE" sysosnap) ;恢复对象捕捉设置
(setvar "ANGDIR" sysang) ;恢复角度方向
(setvar "ANGBASE" sysabase) ;恢复方向的基准角度
(command "ucs" "p") ;恢复ucs
(exit) ;退出
)
)
(setq i 0 m 0 n 0) ;设置计数器,m为转换单行文本个数,n为多行文本个数
(repeat (sslength s1)
(setq entname (ssname s1 i))
(setq nlist (entget entname))
(setq tid (cdr (assoc 0 nlist))) ;判断是单行文本或多行文本
(if (= tid "TEXT") ;如果是单行文本,先转换为多行文本
(progn
(setq m (1+ m)) ;计数器
(setq tt (cdr (assoc 1 nlist))) ;取得文字
(setq th (cdr (assoc 40 nlist))) ;取得文字高度
(setq pt (cdr (assoc 10 nlist))) ;取得文字插入点
(setq ang (cdr (assoc 50 nlist))) ;取得文字旋转角度
(setq ttlen (strlen tt)) ;取得文字长度
(setq twid (* (* th 0.7) ttlen)) ;计算文字宽度,不同字体、CAD版本、图形,文字高度与宽度关系可能不同,可直接修改系数0.7为适当值
(setq tang (/ (* 180 (+ ang (atan(/ th twid)))) pi)) ;计算多行文本对角点的旋转角度
(setq tlen (sqrt (+ (* th th) (* twid twid)))) ;计算多行文本对角线的长度
(setq tstr (strcat "@" (rtos tlen) "<" (rtos tang))) ;对角点的相对坐标
(setq ang (/ (* ang 180) pi)) ;转换弧度为角度
(command "-mtext" pt "h" th "r" ang tstr tt "") ;在原位置以原角度原高度生成多行文本
(entdel entname) ;删除单行文本
(setq entname (entlast)) ;取出最近转换成的多行文本
(setq nlist (entget entname))
(setq addlist (list(cons 45 1.1))) ;背景遮罩边界偏移因子为1.1
(setq addlist (cons (cons 63 256) addlist));填充颜色使用图形背景颜色
(setq addlist (cons (cons 90 3) addlist)) ;表示使用背景颜色,另外组码441为背景的透明度,目前版本无法使用,系统会自动增加该组码
(if (= (assoc 45 nlist) nil) ;如果多行文本未使用背景遮罩,增加组码
(progn
(setq nlist (append nlist addlist)) ;增加上面3个组码
(entmod nlist) ;更新显示
)
(progn ;如果已使用背景遮罩,直接更改组码
(setq nlist (subst (cons 45 1.1) (assoc 45 nlist) nlist)) ;作用同上
(setq nlist (subst (cons 63 256) (assoc 63 nlist) nlist))
(setq nlist (subst (cons 90 3) (assoc 90 nlist) nlist))
(entmod nlist)
)
)
)
(progn
(if (= tid "MTEXT") ;如果是多行文本
(progn
(setq n (1+ n)) ;计数器
(setq addlist (list(cons 45 1.1))) ;背景遮罩边界偏移因子为1.1
(setq addlist (cons (cons 63 256) addlist)) ;填充颜色使用图形背景颜色
(setq addlist (cons (cons 90 3) addlist)) ;表示使用背景颜色,另外组码441为背景的透明度,目前版本无法使用,系统会自动增加该组码
(if (= (assoc 45 nlist) nil) ;如果多行文本未使用背景遮罩,增加组码
(progn
(setq nlist (append nlist addlist)) ;增加上面3个组码
(entmod nlist) ;更新显示
)
(progn ;如果已使用背景遮罩,直接更改组码
(setq nlist (subst (cons 45 1.1) (assoc 45 nlist) nlist)) ;作用同上
(setq nlist (subst (cons 63 256) (assoc 63 nlist) nlist))
(setq nlist (subst (cons 90 3) (assoc 90 nlist) nlist))
(entmod nlist)
)
)
)
)
)
)
(setq i (1+ i))
)
(setvar "OSMODE" sysosnap) ;恢复对象捕捉设置
(setvar "ANGDIR" sysang) ;恢复角度方向
(setvar "ANGBASE" sysabase) ;恢复方向的基准角度
(command "ucs" "p") ;恢复ucs
(prompt (strcat "转换单行文本" (itoa m) "个,多行文本" (itoa n) "个。请验证是否正确!"))
)