社区 › AutoLISP/Visual LISP 编程技术 › 求rename命令增强版

weiqi 发表于 2013-10-30 20:54:06

求rename命令增强版

本帖最后由 weiqi 于 2013-11-2 22:31 编辑

求在一个DWG图里,rename命令增加版，把图层，块名，标注样式等。。。一个命令全部加上前缀。

rhett_sky 发表于 2015-1-3 13:12:41

这个我也需要

weiqi 发表于 2018-11-9 22:58:27

自己解决多年~

刘炎华 发表于 2023-7-3 11:29:11

产品图导入时，一直都是手动改，可以分享吗

andyding 发表于 2023-7-4 14:00:10

本帖最后由 andyding 于 2023-7-4 16:10 编辑

所有通用函数来自论坛，非本人原创。搬运拼凑而成，试试看能不能用吧。

(defun C:renall(/ BLOCKLST blockna DIMLST I LAYERLST M N P PRE TEXTLST)
(command "_undo" "be")
(setq *ACAD*(vlax-get-acad-object)
      *DOC*   (vla-get-ActiveDocument *ACAD*)
)
(if (and
(setq blocklst (MJ:blocks))
(setq layerlst (MJ:layers))
(setq textlst (MJ:textstyles))
(setq dimlst (MJ:dimstyles))
      )
    (progn
      (setq i 0
      n 0
      m 0
      P 0
      )
      (setq pre (getstring "\n请输入前缀："))
      (repeat (length blocklst)
(if (= (substr (nth i blocklst) 1 1) "*")
    (setq blockna (substr (nth i blocklst) 2))
    (setq blockna (nth i blocklst))
)
(MJ:RenameBlock1
    (nth i blocklst)
    (strcat pre blockna)
)
(setq i (1+ i))
      )
      (repeat (length layerlst)
(if (/= (nth n layerlst) "0")
    (progn
      (MJ:Renamelayer1
      (nth n layerlst)
      (strcat pre (nth n layerlst))
      )
      (setq n (1+ n))
    )
    (setq n (1+ n))
)
      )
      (repeat (length textlst)
(command "_.rename"
   "s"
   (nth m textlst)
   (strcat pre (nth m textlst))
)
(setq m (1+ m))
      )
      (repeat (length dimlst)
(MJ:RenameDimStyles1
    (nth p dimlst)
    (strcat pre (nth p dimlst))
)
(setq p (1+ p))
      )
      (vla-auditinfo
(vla-get-activedocument (vlax-get-acad-object))
:vlax-true
      )
    )
)
(command "_undo" "end")
(princ)
)

;;改块名，bn的块存在,名为nn的块不存在
;;(MJ:RenameBlock1 "ccd1" "ccd2")
(defun MJ:RenameBlock1 (bn nn /)
(vla-put-name (vla-item (vla-get-blocks *DOC*) bn) nn)
)
;;改层名
(defun MJ:Renamelayer1 (bn nn /)
(vla-put-name (vla-item (vla-get-layers *DOC*) bn) nn)
)
;;改字体样式名
(defun MJ:RenameDimStyles1 (bn nn /)
(vla-put-name (vla-item (vla-get-DimStyles *DOC*) bn) nn)
)


;; 返回块名列表("*D5" "A$C263E5435" "b2" "b1")
(defun MJ:blocks (/ b bn tl)
(vlax-for b (vla-get-blocks *DOC*)
    (if(= (vla-get-islayout b) :vlax-false)
      (setq tl (cons (vla-get-name b) tl))
    )
)
(reverse tl)
)
;; 返回层名列表
(defun MJ:layers (/ b bn tl)
(vlax-for b (vla-get-layers *DOC*)
    (setq tl (cons (vla-get-name b) tl))
)
(reverse tl)
)

;; 返回字体样式名列表
(defun MJ:textstyles (/ b bn tl)
(vlax-for b (vla-get-textstyles *DOC*)
    (setq tl (cons (vla-get-name b) tl))
)
(reverse tl)
)
;; 返回标注样式列表
(defun MJ:dimstyles (/ b bn tl)
(vlax-for b (vla-get-DimStyles *DOC*)
    (setq tl (cons (vla-get-name b) tl))
)
(reverse tl)
)

寒潮大冬瓜 发表于 2024-7-21 22:34:39

andyding大侠好！我试用了似乎不能实现RENAME的功能哟！我也是希望能集成化一次搞定(层+样式+块)前面加前缀或者后缀！我上2月提出后有个大侠编了一个能顺利实施的！可惜不是一个集成化的……
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=190222&highlight=RENAME

查看完整版本: 求rename命令增强版