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

寒潮大冬瓜

能顺利用代码实现全选0图层图元移动到新图层，可惜还没找到能通过lisp把字体‘standard’另存为名的操作！
http://bbs.mjtd.com/forum.php?mo ... 8144&fromuid=418631
主要是想完全修改名称，明显用andyding于2023-7-4 16:10编辑的代码还是有‘standard’字体未能实现另存名的。

pzweng

(defun c:tt1  nil
  (vl-load-com)
(setq myacad (vlax-get-acad-object))                       ;获取AutoCAD应用程序对象
(setq mydoc (vla-get-activedocument myacad))               ;获取活动文档对象
  
  (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list myacad (if (< (setq vrs (atoi (getvar 'acadver))) 16) "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))))))

  (setq old "你") ;已有的样式名
  (setq new "我") ;新增的样式名
  (setq pattern (strcat old "," old "$*"))
  (setq lst '() lst2 '())
  
  (vlax-for o doc_dims (and (wcmatch (vla-get-name o) pattern) (setq lst (cons o lst))))

  (vlax-invoke mydoc 'copyobjects lst (vla-get-dimstyles dbx))
  (foreach n (mapcar 'vla-get-name lst) (setq lst2 (cons (vla-item (vla-get-dimstyles mydoc) n) lst2)))

  (foreach o lst (vla-put-name o (vl-string-subst new old (vla-get-name o)))) ;当前样式改名
  
  (vlax-invoke dbx 'copyobjects lst2 (vla-get-dimstyles mydoc)) ;复制回当前
  (princ)
  )

bonny

所谓另存，只是主观感受的描述，实际上就是新建一个样式，继承了各种属性(名字除外，句柄啥的其它的自动会修正的)

• (entmakex(subst (cons 2 "波多菠萝蜜") (cons 2 "Standard") (entget (tblobjname "STYLE" "Standard"))))
  

寒潮大冬瓜

自贡黄明儒 发表于 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)))
    )
  )
)

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

hi7720

(command "-RENAME" "D" "Standard" "NewDimstyle")

paulpipi

下载试用一下，谢谢分享

寒潮大冬瓜

hi7720 发表于 2024-7-27 00:50
(command "-RENAME" "D" "Standard" "NewDimstyle")

感谢指导！我试了似乎没能实现……

pzweng

标注样式“Standard”和文字样式“Standard” 不能删除和改名的，和图层"0" 一个道理

寒潮大冬瓜

pzweng 发表于 2024-7-27 13:43
标注样式“Standard”和文字样式“Standard” 不能删除和改名的，和图层"0" 一个道理

感谢大侠指导！我就是想通过lisp代码来实现，0图层就是通过‘YESE2024移动0图层图元到指定图层.lsp’实现了，特意在这里期待大侠出手指导实现

pzweng

寒潮大冬瓜 发表于 2024-7-27 15:59
感谢大侠指导！我就是想通过lisp代码来实现，0图层就是通过‘YESE2024移动0图层图元到指定图层.lsp’实现 ...

将0图层上的图元移到其它层？ LAYTRANS 这个命令知道吗？

寒潮大冬瓜

pzweng 发表于 2024-7-27 16:13
将0图层上的图元移到其它层？ LAYTRANS 这个命令知道吗？

我是菜鸟！感谢指导！