期待通过lisp把字体‘standard’另存为名的操作

自贡黄明儒

来一个VBA AI写的"新建文字样式"

1. Public Sub CreateNewTextStyle()
   
2.     Dim acadApp As Object
   
3.     Dim acadDoc As Object
   
4.     Dim acadTextStyles As Object
   
5.     Dim newTextStyleName As String
   
6.    
   
7.     ' 连接到AutoCAD应用程序和文档
   
8.     On Error Resume Next
   
9.     Set acadApp = GetObject(, "AutoCAD.Application")
   
10.     If Err Then
    
11.         MsgBox "AutoCAD程序未运行"
    
12.         Exit Sub
    
13.     End If
    
14.     On Error GoTo 0
    
15.     Set acadDoc = acadApp.ActiveDocument
    
16.    
    
17.     ' 新文字样式的名称
    
18.     newTextStyleName = "MyNewTextStyle"
    
19.    
    
20.     ' 获取文字样式表
    
21.     Set acadTextStyles = acadDoc.TextStyleTable
    
22.    
    
23.     ' 检查样式是否已存在
    
24.     If Not acadTextStyles.Has(newTextStyleName) Then
    
25.         ' 创建新的文字样式
    
26.         With acadTextStyles.Add(newTextStyleName)
    
27.             ' 设置文字样式的属性
    
28.             .Font = "Arial"
    
29.             .BigFont = "Arial Bold"
    
30.             .Height = 4.2
    
31.             .Italic = acadFalse
    
32.             .Bold = acadFalse
    
33.             .CharSet = 1
    
34.             .IsLineType = acadFalse
    
35.             .IsVertical = acadFalse
    
36.             .IsBackward = acadFalse
    
37.             .IsReverse = acadFalse
    
38.             .IsSuperscript = acadFalse
    
39.             .IsSubscript = acadFalse
    
40.             .IsUnderline = acadFalse
    
41.             .IsStrikeOut = acadFalse
    
42.             .Rotation = 0
    
43.             .WidthFactor = 1
    
44.             .ObliquingAngle = 0
    
45.             .TrackingFactor = 1
    
46.         End With
    
47.         MsgBox "文字样式创建成功: " & newTextStyleName
    
48.     Else
    
49.         MsgBox "文字样式已存在: " & newTextStyleName
    
50.     End If
    
51. End Sub

Public Sub CreateNewTextStyle()<br />     Dim acadApp As Object<br />     Dim acadDoc As Object<br />     Dim acadTextStyles As Object<br />     Dim newTextStyleName As String<br />     <br />     ' 连接到AutoCAD应用程序和文档<br />     On Error Resume Next<br />     Set acadApp = GetObject(, "AutoCAD.Application")<br />     If Err Then<br />         MsgBox "AutoCAD程序未运行"<br />         Exit Sub<br />     End If<br />     On Error GoTo 0<br />     Set acadDoc = acadApp.ActiveDocument<br />     <br />     ' 新文字样式的名称<br />     newTextStyleName = "MyNewTextStyle"<br />     <br />     ' 获取文字样式表<br />     Set acadTextStyles = acadDoc.TextStyleTable<br />     <br />     ' 检查样式是否已存在<br />     If Not acadTextStyles.Has(newTextStyleName) Then<br />         ' 创建新的文字样式<br />         With acadTextStyles.Add(newTextStyleName)<br />             ' 设置文字样式的属性<br />             .Font = "Arial"<br />             .BigFont = "Arial Bold"<br />             .Height = 4.2<br />             .Italic = acadFalse<br />             .Bold = acadFalse<br />             .CharSet = 1<br />             .IsLineType = acadFalse<br />             .IsVertical = acadFalse<br />             .IsBackward = acadFalse<br />             .IsReverse = acadFalse<br />             .IsSuperscript = acadFalse<br />             .IsSubscript = acadFalse<br />             .IsUnderline = acadFalse<br />             .IsStrikeOut = acadFalse<br />             .Rotation = 0<br />             .WidthFactor = 1<br />             .ObliquingAngle = 0<br />             .TrackingFactor = 1<br />         End With<br />         MsgBox "文字样式创建成功: " & newTextStyleName<br />     Else<br />         MsgBox "文字样式已存在: " & newTextStyleName<br />     End If<br /> End Sub

寒潮大冬瓜

自贡黄明儒 发表于 2024-7-29 14:13
来一个VBA AI写的"新建文字样式"

感谢黄大侠指导！
;sxxg1属性块参数修改黄明儒大侠收集函数
(DEFUN C:sxxg1()
        ;(setq CSNewwenziName2024(getstring(strcat "\n请输入拟修改的属性块内参数名：<修正号>")))
        ;(setq NewwenziName2024(getstring(strcat "\n请输入拟修改的属性块内参数名：<A>")))
        ;(princ "\n请选择要改变的图元文字样式名2024年04月29日22时07分10秒")
        (MJ-ChangeAttribute (list (car (entsel)) '("修正号" . "")))
                ;(MJ-ChangeAttribute (list (car (entsel)) '(CSNewwenziName2024 . NewwenziName2024)))
                        ;(MJ-ChangeAttribute (list (car (entsel)) '(CSNewwenziName2024  NewwenziName2024)))
        (princ))
;;30.5 [功能] 更改块多个属性
;; 示例: (MJ-ChangeAttribute (list ename '("MJ-Attribute" . "NewValue")))
;; 示例 (MJ-ChangeAttribute (list (car (entsel)) '("设计" . "NewValue")))
(defun MJ-ChangeAttribute (lst / item atts)
  (vl-load-com)
  (if (safearray-value
                                (setq atts
                                        (vlax-variant-value
                                                (vla-getattributes (vlax-ename->vla-object (car lst)))
                                        )
                                )
      )
    (progn
      (foreach item (cdr lst)
                                (mapcar
                                        '(lambda (x)
                                                 (if
                                                         (= (strcase (car item)) (strcase (vla-get-tagstring x)))
                                                         (vla-put-textstring x (cdr item))
                                                 )
                                         )
                                        (vlax-safearray->list atts)
                                )
      )
      (vla-update (vlax-ename->vla-object (car lst)))
    )
  )
)

这个我想实现参数化，似乎还差大侠指导一下

寒潮大冬瓜

bonny 发表于 2024-7-28 12:24
所谓另存，只是主观感受的描述，实际上就是新建一个样式，继承了各种属性(名字除外，句柄啥的其它的自动会 ...

感谢波总指导！讲得非常透彻！

pzweng

寒潮大冬瓜 发表于 2024-7-29 20:48
感谢波总指导！讲得非常透彻！

A.dwg图纸的标注文字样式是standard，字体是宋体。
B.dwg图纸的标注文字样式是standard，字体是黑体。
想把B.dwg图纸里的复制到A.dwg里面，但不想影响原字体（很多字体外宽不一样），如改不改字体样式名，复制过去后会被覆盖掉。
但文字样式名“Standard”不允许被改名。

实现方式：
       将文件另存为dxf，找到“AcDbTextStyleTableRecord”下面的“Standard”，改成你想要的名字，
        保存打开后所有与原“Standard”样式有关的图元和设置都改了。

这个操作比较麻烦，期等高手用高科技解决。

寒潮大冬瓜

pzweng 发表于 2024-7-30 09:51
A.dwg图纸的标注文字样式是standard，字体是宋体。
B.dwg图纸的标注文字样式是standard，字体是黑体。
...

http://bbs.mjtd.com/forum.php?mo ... light=RENAME&page=3
xtjd积分17816注册时间2004-9-7最后登录2024-7-30发表于 2024-7-29 08:59 | 只看该作者
240729更新：图层0及字体standard更名
rename增强版.fas (3 KB, 下载次数: 0, 售价: 1 个明经币)
这里有大侠出了批量改名的插件，你可以试试，就能去掉你说的烦恼！

pzweng

寒潮大冬瓜 发表于 2024-7-30 20:21
http://bbs.mjtd.com/forum.php?mo ... light=RENAME&page=3
xtjd积分17816注册时间2004-9-7最后登录202 ...

没用的，字休样式standard改不了的

muai2010

分享的插件还不如

CAD智能@未来

pzweng 发表于 2024-7-30 09:51
A.dwg图纸的标注文字样式是standard，字体是宋体。
B.dwg图纸的标注文字样式是standard，字体是黑体。
...

A.dwg图纸的标注文字样式是standard，字体是宋体。
B.dwg图纸的标注文字样式是standard，字体是黑体。
想把B.dwg图纸里的复制到A.dwg里面，但不想影响原字体（很多字体外宽不一样），如改不改字体样式名，复制过去后会被覆盖掉。
但文字样式名“Standard”不允许被改名。
实现方法是不是也可以把A参照到B中，将A进行绑定，会自动给A中字体添加前缀。