更改属性textstyle wit

Corro · 发表于 2022-7-5 17:30:06

大家好

我试图创建一个lisp例程来更改块中的属性textstyle，在同一个图形中有多个不同的块需要更改。
这也适用于许多图纸，使其符合更新的CAD标准。
附件是当前程序，但我在关联第一部分块的变量时遇到问题，因为我需要当前的文本样式和文本高度，然后才能定义新值。
我能够将ActiveX名称转换为lisp名称并设置变量“nam”，但我无法从这个“块”对象中提取任何文本变量。
下面的部分，属性定义，似乎有效。
我还附上了一个小样本的块。如果双击块并选中文本选项，则文本样式为TXT-35（TXT-18）。如果分解块，文字样式为罗马文字，具有不同的高度。
感谢您的帮助。
当做
史蒂夫
演示CBS_1。lsp
参考-1。图纸

rlx · 发表于 2022-7-5 17:38:58

Ho Corro，

我已经包括了一个文件，其中有一个a去年写的例程。它并没有很好的文档记录，但可能有一些东西你可以使用。

问题是，我是否可以编写一个应用程序，能够更改具有特定块名的列表的文本样式。也许它有用，也许它不是。。。

gr.Rlx
vth。LSP

Corro · 发表于 2022-7-5 17:41:35

大家好
我现在有一个时间表来完成这个列表例程。
附件是我的目的，但我需要能够确定属性的当前TextStyle，然后比较它们以设置替换TextStyle。
我还附上了一个包含属性和属性定义的块的示例，我需要更改这两个块的textstyle。
同时附上了我如何将当前的文本风格与新风格进行比较的设想。
感谢您的帮助。
谢谢
哥伦比亚广播公司。lsp
参考-1。图纸
示例条件声明。txt文件

Roy_043 · 发表于 2022-7-5 17:49:06

@腐蚀：
请尝试下面的代码。
注意：att.REF使用的某些文本样式与att.DEF使用的文本样式不匹配。代码并没有解决这个问题。

copy

(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)
)

Corro · 发表于 2022-7-5 17:56:53

嗨，罗伊
谢谢你的回复。
运行时，会出现错误“错误的参数类型：stringp nil”
变量“hgt”、“newstl”、“doc”和“obj”均为零。
有什么想法吗？
谢谢

Roy_043 · 发表于 2022-7-5 17:59:35

问题是由以下线路引起的：
如果newStl为零，则（strcat）将失败。

修订代码：

copy

(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)
)