期待通过lisp把字体‘standard’另存为名的操作
本帖最后由 寒潮大冬瓜 于 2024-7-27 00:29 编辑能顺利用代码实现全选0图层图元移动到新图层，可惜还没找到能通过lisp把字体‘standard’另存为名的操作！
http://bbs.mjtd.com/forum.php?mo ... 8144&fromuid=418631
主要是想完全修改名称，明显用andyding于2023-7-4 16:10编辑的代码还是有‘standard’字体未能实现另存名的。
(defun c:tt1nil
(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 于 2024-7-28 12:28 编辑
所谓另存，只是主观感受的描述，实际上就是新建一个样式，继承了各种属性(名字除外，句柄啥的其它的自动会修正的)
[*](entmakex(subst (cons 2 "波多菠萝蜜") (cons 2 "Standard") (entget (tblobjname "STYLE" "Standard"))))
本帖最后由 寒潮大冬瓜 于 2024-7-29 20:47 编辑
自贡黄明儒 发表于 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)) '(CSNewwenziName2024NewwenziName2024)))
(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)))
)
)
)
这个我想实现参数化，似乎还差大侠指导一下
(command "-RENAME" "D" "Standard" "NewDimstyle") 下载试用一下，谢谢分享 hi7720 发表于 2024-7-27 00:50
(command "-RENAME" "D" "Standard" "NewDimstyle")
感谢指导！我试了似乎没能实现…… 标注样式“Standard”和文字样式“Standard” 不能删除和改名的，和图层"0" 一个道理 pzweng 发表于 2024-7-27 13:43
标注样式“Standard”和文字样式“Standard” 不能删除和改名的，和图层"0" 一个道理
感谢大侠指导！我就是想通过lisp代码来实现，0图层就是通过‘YESE2024移动0图层图元到指定图层.lsp’实现了，特意在这里期待大侠出手指导实现 寒潮大冬瓜 发表于 2024-7-27 15:59
感谢大侠指导！我就是想通过lisp代码来实现，0图层就是通过‘YESE2024移动0图层图元到指定图层.lsp’实现 ...
将0图层上的图元移到其它层？ LAYTRANS 这个命令知道吗？ pzweng 发表于 2024-7-27 16:13
将0图层上的图元移到其它层？ LAYTRANS 这个命令知道吗？
我是菜鸟！感谢指导！
页:
[1]
2