帮忙写个批量修改文本属性的lisp
本帖最后由 石井鱼 于 2016-1-25 08:52 编辑请哪位大侠写个小程序，功能如下：
框选图中文字，将文字属性修改：对齐方式改为左对齐；字高改为300；字宽改为0.6；字体颜色改为1号色；字体样式改为“TSSD_Rein”，如果没有定义，新创建该字体样式，英中字体分别为tssdeng.shx和tssdchn.shx。
以上功能单独的程序有，但是一个个用效率低，麻烦大侠给集合至一个命令，使用起来快捷些，先谢了。
上面程序有点错误，现上传lsp 自己把单独的程序改改就可以 zwf100 发表于 2016-1-17 20:06 static/image/common/back.gif
自己把单独的程序改改就可以
菜鸟不会改，所以来求助帮忙的 ;|
框选图中文字，将文字属性修改：对齐方式改为左对齐；字高改为300；字宽改为0.6；
字体颜色改为1号色；字体样式改为“TSSD_Rein”，如果没有定义，新创建该字体样式，
英中字体分别为tssdeng.shx和tssdchn.shx。
|;
(defun c:test()
(vl-load-com)
;;如果没有定义字体样式TSSD_Rein”，新创建该字体样式
(setq ac (vla-get-ActiveDocument(vlax-get-acad-object)))
(setq tt (vla-get-TextStyles ac))
(if
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-Item (list tt "TSSD_Rein"))
)
(entmake '(
(0 . "STYLE")(100 . "AcDbSymbolTableRecord")(100 . "AcDbTextStyleTableRecord")
(2 . "TSSD_Rein")(70 . 0) (40 . 300) (41 . 0.6) (3 . "tssdeng.shx") (4 . "tssdchn.shx")
)
)
)
;;更改选中文字属性
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if ss
(setq vlalist (ssget->vla-list ss))
)
(foreach obj vlalist
(vlax-put-property obj 'StyleName "TSSD_Rein")
(vlax-put-property obj 'Height 300)
(setq en (vlax-vla-object->ename obj)
ent (entget en)
old72 (assoc 72 ent)
old73 (assoc 73 ent)
nent (subst (cons 72 0) old72 ent)
nent (subst (cons 73 0) old73 nent)
)
(entmod nent)
(vla-put-Color obj 1)
)
)
(defun ssget->vla-list (ss / i ename lst)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq lst (cons (vlax-ename->vla-object ename) lst))
)
lst
)
恒毅 发表于 2016-1-26 17:27 static/image/common/back.gif
上面程序有点错误，现上传lsp
万分感谢恒毅，辛苦写了这么好的程序，工作中经常用的，再次感谢帮大忙！
页:
[1]