更改属性textstyle wit
大家好我试图创建一个lisp例程来更改块中的属性textstyle，在同一个图形中有多个不同的块需要更改。
这也适用于许多图纸，使其符合更新的CAD标准。
附件是当前程序，但我在关联第一部分块的变量时遇到问题，因为我需要当前的文本样式和文本高度，然后才能定义新值。
我能够将ActiveX名称转换为lisp名称并设置变量“nam”，但我无法从这个“块”对象中提取任何文本变量。
下面的部分，属性定义，似乎有效。
我还附上了一个小样本的块。如果双击块并选中文本选项，则文本样式为TXT-35（TXT-18）。如果分解块，文字样式为罗马文字，具有不同的高度。
感谢您的帮助。
当做
史蒂夫
演示CBS_1。lsp
参考-1。图纸 Ho Corro，
我已经包括了一个文件，其中有一个a去年写的例程。它并没有很好的文档记录，但可能有一些东西你可以使用。
问题是，我是否可以编写一个应用程序，能够更改具有特定块名的列表的文本样式。也许它有用，也许它不是。。。
gr.Rlx
vth。LSP 大家好
我现在有一个时间表来完成这个列表例程。
附件是我的目的，但我需要能够确定属性的当前TextStyle，然后比较它们以设置替换TextStyle。
我还附上了一个包含属性和属性定义的块的示例，我需要更改这两个块的textstyle。
同时附上了我如何将当前的文本风格与新风格进行比较的设想。
感谢您的帮助。
谢谢
哥伦比亚广播公司。lsp
参考-1。图纸
示例条件声明。txt文件 @腐蚀：
请尝试下面的代码。
注意：att.REF使用的某些文本样式与att.DEF使用的文本样式不匹配。代码并没有解决这个问题。
(vl-load-com)
; Return 1 or 0 (=fail).
(defun TextStyleChange (obj / hgt newStl stl)
(setq hgt (vla-get-height obj))
(setq stl (strcase (vla-get-stylename obj)))
(if
(and
(setq newStl
(cond
((wcmatch stl "TXT-##,TXT-#")
(strcat (substr stl 5) "-TEXT")
)
((= stl "ROMANS")
(cond
((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
"13-TEXT"
)
((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
"18-TEXT"
)
((= hgt 250.0)
"25-TEXT"
)
((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
"35-TEXT"
)
((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
"5-TEXT"
)
(T
"7-TEXT"
)
)
)
)
)
(tblobjname "style" newStl)
)
(progn
(vla-put-stylename obj newStl)
1
)
(progn
(princ (strcat "\nError: " newStl " not found "))
0
)
)
)
(defun c:demo ( / doc i ss)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for blk (vla-get-blocks doc)
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
(TextStyleChange obj)
)
)
)
)
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
(TextStyleChange obj)
)
)
)
(vla-regen doc acallviewports)
(princ)
) 嗨，罗伊
谢谢你的回复。
运行时，会出现错误“错误的参数类型：stringp nil”
变量“hgt”、“newstl”、“doc”和“obj”均为零。
有什么想法吗？
谢谢 问题是由以下线路引起的：
如果newStl为零，则（strcat）将失败。
修订代码：
(vl-load-com)
; Returns T or nil (=fail).
(defun TextStyleChange (obj / hgt newStl stl)
(setq hgt (vla-get-height obj))
(setq stl (strcase (vla-get-stylename obj)))
(if
(and
(setq newStl
(cond
((wcmatch stl "TXT-##,TXT-#")
(strcat (substr stl 5) "-TEXT")
)
((= stl "ROMANS")
(cond
((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
"13-TEXT"
)
((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
"18-TEXT"
)
((= hgt 250.0)
"25-TEXT"
)
((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
"35-TEXT"
)
((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
"5-TEXT"
)
(T
"7-TEXT"
)
)
)
)
)
(or
(tblobjname "style" newStl)
(progn
(princ (strcat "\nError: " newStl " not found "))
nil
)
)
)
(progn
(vla-put-stylename obj newStl)
T
)
)
)
(defun c:demo ( / doc i ss)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for blk (vla-get-blocks doc)
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
(TextStyleChange obj)
)
)
)
)
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
(TextStyleChange obj)
)
)
)
(vla-regen doc acallviewports)
(princ)
) 嗨，罗伊
工作起来很有魅力。
另一个要求刚刚提出，如果当前样式存在，例如35-TEXT，但它有罗马字体，则例程需要将其更改为ARIAL字体。
你要帮忙吗？
再次感谢 您可能需要更改的名称。ttf文件（“arial.ttf”）。
所有#-文本和#-文本样式都更改为Arial（但我不确定这是否是您想要的）。
3 嗨，罗伊
它生成“自动化错误。文件错误”
以前从未见过。
任何想法。
再次感谢 嗨，罗伊
已解决错误。
只需为arial添加文件位置。ttf文件
谢谢
页:
[1]
2