【悬赏】提取图框中标记为[图号]的属性值修改当前布局名称
【问题】为了使用图纸集或者批量发布的功能，布局命名必须做到规范，经常需要复制属性值而后修改布局名称，基本需要双击属性，复制，右键修改布局名称，再黏贴六次点击,上千张图纸就是几千个动作，而且经常会遗漏，希望高手帮助，谢谢！
见附件图框文件
希望实现功能：
1.输入bj则以图框中标记为【图号】的属性值修改当前布局名称，如果当前为模型空间则提示错误
2.输入th则将当前布局名称替换图框中标记为【图号】的属性值（为上面命令的逆操作）
【另】如果能做到在模型空间输入命令则自动把所有布局中图框中这个属性跟布局匹配则另加10个币赏金;P，当然会强制每个布局只有一个图框文件
图框文件的图块名称为A1_Tileblock或AX_Tileblock...
本帖最后由 vectra 于 2017-9-27 16:24 编辑
;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))
(defun get-att-textstrings (obj names / rt tag)
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
(setq tag (vla-get-tagstring att))
(if (member tag names)
(setq rt (cons (cons tag (vla-get-textstring att)) rt))
)
)
(reverse rt)
)
;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))
(defun put-att-textstrings (obj values / text)
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
(if (setq text (cdr (assoc (vla-get-tagstring att) values)))
(vla-put-textstring att text)
)
)
)
;; 以图框中标记为“图号”的属性值修改当前布局名称
(defun c:th (/ name obj ss)
(if (= "Model" (getvar "CTAB"))
(princ "无法在模型空间中使用该命令。")
(if (setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(setq obj(vlax-ename->vla-object (ssname ss 0))
name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
)
(command "_.LAYOUT" "R" "" name)
)
)
)
(princ)
)
;; 当前布局名称替换图框中标记为“图号”的属性值
(defun c:bj (/ obj ss)
(if (= "Model" (getvar "CTAB"))
(princ "无法在模型空间中使用该命令。")
(if (setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))
)
)
)
(princ)
)
每个布局里必须要放且只能有一个图框。欢迎测试反馈BUG。
vectra 发表于 2017-9-27 14:58
每个布局里必须要放且只能有一个图框。欢迎测试反馈BUG。
更新增加批量替换batchth、 batchbj两命令。 ...
测试很不错，超级赞。:lol 另外请您点选我回答，我才能选已解决转币给您:lol 本帖最后由 vectra 于 2017-9-27 16:28 编辑
;;;(get-att-textstrings (vlax-ename->vla-object (car (entsel))) '("图号" "图名文字1"))
(defun get-att-textstrings (obj names / rt tag)
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
(setq tag (vla-get-tagstring att))
(if (member tag names)
(setq rt (cons (cons tag (vla-get-textstring att)) rt))
)
)
(reverse rt)
)
;;;(put-att-textstrings (vlax-ename->vla-object (car (entsel))) '(("图号" . "ABC")))
(defun put-att-textstrings (obj values / text)
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-getattributes obj))
)
(if (setq text (cdr (assoc (vla-get-tagstring att) values)))
(vla-put-textstring att text)
)
)
)
;; 以图框中标记为“图号”的属性值修改当前布局名称
(defun c:th (/ name obj ss)
(if (= "Model" (getvar "CTAB"))
(princ "无法在模型空间中使用该命令。")
(if (setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(setq obj(vlax-ename->vla-object (ssname ss 0))
name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
)
(command "_.LAYOUT" "R" "" name)
)
)
)
(princ)
)
;; 当前布局名称替换图框中标记为“图号”的属性值
(defun c:bj (/ obj ss)
(if (= "Model" (getvar "CTAB"))
(princ "无法在模型空间中使用该命令。")
(if (setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 (getvar "CTAB"))
)
)
)
(progn
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(put-att-textstrings obj (list (cons "图号" (getvar "CTAB"))))
)
)
)
(princ)
)
(defun c:batchbj (/ lname obj ss)
(vlax-for layout (vla-get-layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(setq lname (vla-get-name layout))
(if (and
(not (= :vlax-true (vla-get-modeltype layout)))
(setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 lname)
)
)
)
)
(progn
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(put-att-textstrings obj (list (cons "图号" lname)))
)
)
)
(princ)
)
(defun c:batchth (/ lname name obj ss)
(vlax-for layout (vla-get-layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(setq lname (vla-get-name layout))
(if (and
(not (= :vlax-true (vla-get-modeltype layout)))
(setq ss (ssget "X"
(list '(0 . "INSERT")
'(2 . "A*_Tileblock")
(cons 410 lname)
)
)
)
)
(progn
(setq obj(vlax-ename->vla-object (ssname ss 0))
name (cdr (assoc "图号" (get-att-textstrings obj '("图号"))))
)
(setq er (vl-catch-all-apply 'vla-put-name (list layout name)))
(if (vl-catch-all-error-p er)
(princ (strcat (vl-catch-all-error-message er) " \"" name "\"")
)
)
)
)
)
(princ)
)
更新增加批量替换batchth、 batchbj两命令。 vectra 发表于 2017-9-27 16:23
更新增加批量替换batchth、 batchbj两命令。
老大，猜测是点第一楼我悬赏下面的那个我回答:lol 本帖最后由 头大无恼 于 2017-9-27 17:12 编辑
版主，已经解决 原来是选择最佳答案 本帖最后由 Atsai 于 2017-10-3 21:00 编辑
将『图号』的属性设置：右键插入功能变数 -> 系统变数 -> ctab
也可以实现楼主要的结果！
附加的档案是我用楼主的档案做成功能变数，试着把他丢到配置看看吧！
图号的内容就是跟着配置名称连动的！