单行文本遮罩批量处理

ttmc

最近一直做结构设计，大量遇到在线形上标注文字的情况。但单行文本没有多行或标注一样的文本遮罩功能。而wipeout命令又太难用，需要点几个点才完成一个。我这个小程序，也是利用了在文字上面wipeput，把文字再复制回来。我是利用文字框放大1.1倍的方式实际框与文字出现间距。只是文字太长，两边空格较大就不美观了。欢迎大家修改完善这个功能。初学，请

2. <div class="blockcode"><blockquote>(defun c:wpt(/ os i ii ss ssn ssdata key box p1 p3 p2 p4 px1 py1 px3 py3 mx my mpt ee )
   
3.   (setvar "cmdecho" 0)
   
4.   (setq os (getvar "osmode"))    ;取得捕捉形式   
   
5.   (setvar "osmode" 0)                   ;取消捕捉，如果不取消，会出错
   
6. (setq clay (getvar "CLAYER"))    ;层初始状态
   
7. ;创建符号层sign颜色31
   
8.   (if (null (tblsearch "LAYER" "sign"))  
   
9.     (command "_layer" "_m" "sign" "_c" 31 "" "_lt" "continuous"  "" "")
   
10.   )
    
11. (command "_layer" "_s" "sign" "") ;设为符号层
    
12.   
    
13.   (setq i 0)                               ;设循环起始点
    
14.   (setq ii 0)
    
15.   (setq ss (ssget))                        ;多选目标
    
16.   (repeat (sslength ss)                    ;循环目标数的次数
    
17.     (setq ssn (ssname ss i))               ;筛选出目标中的第i+1个对象名称
    
18.     (setq ssdata (entget ssn))             ;取出ssn中的数据
    
19.     (setq key (cdr (assoc 0 ssdata)))      ;取出关键字为0的列表
    
20.     (if (= key "TEXT")                     ;如果是单行文本
    
21.       (progn
    
22.   (setq ii (1+ ii))
    
23.          ;(setq ee1 (entlast))        ;文字临时赋值
    
24.    (command "ucs" "e" ssn)            ;以文字为参考坐标系
    
25.    (setq box (textbox ssdata))        ;测量并返回文字方框的对角坐标
    
26.    (setq p1 (car box))                ;取得一个角坐标
    
27.    (setq p3 (cadr box))               ;取得另对角坐标
    
28.    (setq p2 (list (car p3)(cadr p1))) ;取得另外角坐标
    
29.    (setq p4 (list (car p1)(cadr p3)))  ;取得另外角坐标
    
30.    (command "wipeout" p1 p2 p3 p4 "")  ;画遮罩部分
    
31.          
    
32.    (setq ee (entlast))                ;临时赋值
    
33.   
    
34.     ;以下求中心mpt
    
35.          (setq px1 (car p1))
    
36.          (setq py1 (cadr p1))
    
37.          (setq px3 (car p3))
    
38.    (setq py3 (cadr p3))
    
39.     (setq mx (/ (+ px1 px3) 2))
    
40.    (setq my (/ (+ py1 py3) 2))
    
41.   
    
42.    (setq mpt (list mx my))
    
43.   
    
44.    (command "scale"  ee ""  mpt 1.1)
    
45.     (command "copy" ssn "" mpt mpt )
    
46.    (entdel ssn)    ;删除原文字
    
47.   
    
48.       )
    
49.       
    
50.        ;(progn
    
51.     ;(prompt "无单行文字选项，退出！")
    
52.    ;(exit)
    
53.        ;)
    
54.       )
    
55.      
    
56.     (setq i (1+ i))   ;循环+1
    
57.     )
    
58.   (command "ucs" "")     ;返回世界坐标系
    
59.   (prin1)
    
60.   (setvar "osmode" os)     ;返回原始捕捉状态
    
61.   (setvar "CLAYER" clay)    ;返回图层初始状态
    
62.   (princ "\n 共处理了")(princ i ) (princ "个目标中的")(princ ii)(princ "个单行文字。感谢使用！")
    
63.   (prin1)
    
64.    
    
65.   )
    
66. (prompt "单行文字加外框遮罩程序<代替wipeout命令>***** <<wpt>>******")
    
67. (prin1)
    
68.       

<div class="blockcode"><blockquote>(defun c:wpt(/ os i ii ss ssn ssdata key box p1 p3 p2 p4 px1 py1 px3 py3 mx my mpt ee )<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))    ;取得捕捉形式    <br />   (setvar "osmode" 0)                   ;取消捕捉，如果不取消，会出错<br /> (setq clay (getvar "CLAYER"))    ;层初始状态<br /> ;创建符号层sign颜色31<br />   (if (null (tblsearch "LAYER" "sign"))  <br />     (command "_layer" "_m" "sign" "_c" 31 "" "_lt" "continuous"  "" "")<br />   )<br /> (command "_layer" "_s" "sign" "") ;设为符号层<br />   <br />   (setq i 0)                               ;设循环起始点<br />   (setq ii 0)<br />   (setq ss (ssget))                        ;多选目标<br />   (repeat (sslength ss)                    ;循环目标数的次数<br />     (setq ssn (ssname ss i))               ;筛选出目标中的第i+1个对象名称<br />     (setq ssdata (entget ssn))             ;取出ssn中的数据<br />     (setq key (cdr (assoc 0 ssdata)))      ;取出关键字为0的列表<br />     (if (= key "TEXT")                     ;如果是单行文本<br />       (progn<br />   (setq ii (1+ ii))<br />          ;(setq ee1 (entlast))        ;文字临时赋值<br />    (command "ucs" "e" ssn)            ;以文字为参考坐标系<br />    (setq box (textbox ssdata))        ;测量并返回文字方框的对角坐标<br />    (setq p1 (car box))                ;取得一个角坐标<br />    (setq p3 (cadr box))               ;取得另对角坐标<br />    (setq p2 (list (car p3)(cadr p1))) ;取得另外角坐标<br />    (setq p4 (list (car p1)(cadr p3)))  ;取得另外角坐标<br />    (command "wipeout" p1 p2 p3 p4 "")  ;画遮罩部分<br />          <br />    (setq ee (entlast))                ;临时赋值<br />   <br />     ;以下求中心mpt<br />          (setq px1 (car p1))<br />          (setq py1 (cadr p1))<br />          (setq px3 (car p3))<br />    (setq py3 (cadr p3))<br />     (setq mx (/ (+ px1 px3) 2))<br />    (setq my (/ (+ py1 py3) 2))<br />   <br />    (setq mpt (list mx my))<br />   <br />    (command "scale"  ee ""  mpt 1.1)<br />     (command "copy" ssn "" mpt mpt )<br />    (entdel ssn)    ;删除原文字<br />   <br />       )<br />       <br />        ;(progn<br />     ;(prompt "无单行文字选项，退出！")<br />    ;(exit)<br />        ;)<br />       )<br />      <br />     (setq i (1+ i))   ;循环+1<br />     )<br />   (command "ucs" "")     ;返回世界坐标系<br />   (prin1)<br />   (setvar "osmode" os)     ;返回原始捕捉状态<br />   (setvar "CLAYER" clay)    ;返回图层初始状态<br />   (princ "\n 共处理了")(princ i ) (princ "个目标中的")(princ ii)(princ "个单行文字。感谢使用！")<br />   (prin1)<br />    <br />   )<br /> (prompt "单行文字加外框遮罩程序<代替wipeout命令>***** <<wpt>>******")<br /> (prin1)<br />       

大家指教。

ttmc

水仙的错 发表于 2018-4-8 15:40
这个文字的边框能不显示吗？？

内容增加一条 (command "wipeout" "f" "off")即可。我曾尝试过设置图层为不打印或者是透明度高一些的，但打印出来效果就不行或不佳。
也可以把图层颜色31修改为251，看起来也舒服些。打印时，251图层因为没有特别设置，往往也是灰度，不太明显了。
。

ttmc

我又重新编辑了一下，主要是消除了边框。如果需要文字边框，还可以把 (command "wipeout" "f" "off")这行删除。

18603041013

能不能转多行，加上背景呢，这样可能就没有 前置后置的问题了。

qiushizhda

这个结构用用挺不错的，支持一下

冰之绝恋

支持一下

pxt2001

贴个图，才能看到效果。

明_明

谢谢分享，挺好用的。

lxdz443

支持一下，很不错。

香田里浪人

应该叫做单行文字画矩形框吧

水仙的错

这个文字的边框能不显示吗？？

zwf100

不错，有时可用

evayleung

的确很方便，对于结构专业来说。