文字刷-支持块内及部份天正文字（借鉴阿甘的贴仿写）

wzg356

好久不动，练手，参考阿甘文字刷仿写
命令(maTextStr "69999hudd")或maTxt
下载文件"刷文本内容.lsp"含单多行限/不限模两种式切换---仅1行的多行文本MTEXT也算单行文本
刷新时：块内文字只能点选，其余点/框选均可，选不中文字/回车/右键结束

;刷文字工具
(vl-load-com)
;=================
;获取或刷新文本图元内容
;参数Str：nil则获取文本或用新字符串Str更新文本
;成功获取/更新文本则返回字符串，否则返回nil
;(GetORPutStr (car(entsel)) nil)
;(GetORPutStr (car(entsel)) "AFFFAA")
(defun GetORPutStr(e Str / ob obn str0)
        (setq ob(vlax-ename->vla-object e))
        (setq obn(Vlax-Get ob 'ObjectName))        
        (car(vl-remove NIL(mapcar
                (function(lambda(x)
                (setq str0 (vl-catch-all-apply 'Vlax-Get (list ob x)))
                (if (not(vl-catch-all-error-p str0))
                (if (and str
                        (not(vl-string-search "\\P" str0))
                        (not(vl-string-search "\n" str0))
                        ;(not(vl-string-search "\t" str0))
                        );限制更新有多行的文本
                        (progn(Vlax-Put ob X str) str) str0)
                )))
                (vl-remove
                        (if (= obn "AcDbAttributeDefinition")'TextString
                                (if(= obn "AcDbAttribute") 'TagString)
                        );属性文本仅标签值，块内属性取属性值
                        '(TextString Text UpText NameText Text2 DownText TagString)
                )
        )));含更新下标Text2 DownText，取文字内容时仅取上标
)
;(maTextStr "69999hudd")
(defun maTextStr(str / flter ss e0 e1 n)
        (setq flter(strcat
        "TEXT,MTEXT,ATTDEF,ATTRIB,*MULTILEADER,"; 含天正引线
        "TCH_TEXT,TCH_MTEXT,TCH_ARROW,TCH_ELEVATION,TCH_DRAWINGNAME"
        ;天正单/多行、箭头、标高、图名
        ))
        (alert(strcat
                "块内文字需拾取,其他可框取\n内容刷新为:\n"
                str        "\n\n下一步\n拾取或框取要刷新的文本<>:\n"
        ))
        (while
                (setq ss(ssget ":s" (list(cons 0 (strcat"INSERT," flter)))))
                (or(and
                        (= (caar (setq e0(ssnamex ss 0))) 1)
                        (setq e1(car (nentselp (trans (cadar(cdddar e0)) 0 1))))
                        (wcmatch (cdr(assoc 0(entget e1))) flter)
                        (GetORPutStr e1 str)
                        (entupd e1)(entupd(cadar e0))                        
                        );处理块内文字
                        (repeat (setq n(sslength ss))
                                (setq e1(ssname ss (setq n(1- n))))
                                (GetORPutStr e1 str)
                                (entupd e1)
                        )
                )
        )
)
(defun c:maTxt( / str)
        (and (setq str (car(Nentsel "\n文字刷工具\n拾取新文本<>:")))
                (setq str(GetORPutStr str nil))
                (maTextStr str)
        )        
)

wzg356

有文本的天正实体有以下这些（老版本资料）
"TCH*TEXT,TCH_AXIS_LABEL,TCH_ARROW,TCH_COMPOSING,TCH_COORD,TCH_ELEVATION"
  ",TCH_DRAWINGNAME,TCH_INDEXPOINTER,TCH_INDEXPOINTER,TCH_SYMB_SECTION"
  ",TCH_CORNER_WINDOW,TCH_DORMER,TCH_ERRORMSG,TCH_SPACE"
有编程基础的可以查证特性符号后，根据需求添加完善
我没用过天正

moranyuyan

谢谢分享

yshf

谢谢分享

fate_color

好用，谢谢大佬

panliang9

谢谢楼主分享！

p-3-ianlcc

谢谢楼主的分享！
copy下来使用看看