; changes to issued for construction
: thanks to lee mac for original code
(vl-load-com)
; 1.Get current date in mm/dd/yy format.
(defun ddmmyy (/ x today)
(setvar "cmdecho" 0)
(setq x (getvar "CDATE")) ; get current date
(setq today ( rtos x 2 4)) ; convert to a string
(setq date (strcat (substr today 7 2) "." (substr today 5 2) "." (substr today 3 2) ))
)
(setq oldtag1 "DRAWING_STATUS") ;attribute tag name
(setq newstr1 "ISSUED FOR CONSTRUCTION")
(setq oldtag2 "REV_NO");attribute tag name
(setq newstr2 "0")
(setq ss1 (ssget "x"'((0 . "INSERT") (2 . "DA1DRTXT"))))
(setq inc (sslength ss1))
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1)
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2)
) ; end if
) ; end for
) ;end repeat
(setq oldtag1 "REV-NO")
(setq newstr1 "0")
(ddmmyy)
(setq oldtag2 "DATE")
(setq newstr2 date)
(setq oldtag3 "AMENDMENT")
(setq newstr3 "ISSUED FOR CONSTRUCTION")
(setq ss2 (ssget "x"'((0 . "INSERT") (2 . "REVTABLE"))))
(setq inc (sslength ss2))
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1)
)
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2)
)
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3)
)
)
)
(setq ss1 nil)
; (setq ss2 nil)
(princ) 我们使用了一个很好的小脚本“bfind”
这似乎不适用于图纸编号所需的增量编号。我从lee mac下载了批属性编辑器，它看起来很完美，但似乎不起作用。
我选择了要更改的图形和属性，但单击“运行”后，什么都没有发生！它在命令行上显示：“您想放弃所有更改吗？”。选择yes（是）或no（否）将打开file open（文件打开）窗口。我认为这是因为我的cad安装了cadtools，它阻止了属性编辑器连接到标题栏。它还附带了OA分析，这可能也是一个问题。
有什么建议吗？ 如果你发布一个样例绘图，我很乐意为你编写一个LISP例程。
谢谢你的提议，不幸的是，我没有失去在网上张贴一张画的自由。如果您可以发布一个用于增量更改页码的通用lisp，我可以稍后添加标题栏名称和属性名称。如果不是太麻烦的话。
我真的很感谢你的帮助，谢谢！
只需要标题栏 该方法在我发布的代码中都有，但您需要一个变体，它在布局中迭代，并更改正确的变量，即页码。
这里有一个不同的lisp，它可以做到这一点，再加上一些其他的东西，它使用布局名称，布局名称的末尾有一个与图纸编号匹配的数字。
; change the 410 to layout name
;;-------------------=={ Parse Numbers }==--------------------;;
;; ;;
;;Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;s - String to process ;;
;;------------------------------------------------------------;;
;;Returns:List of numerical values found in string. ;;
;;------------------------------------------------------------;;
(defun LM:ParseNumbers ( s )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
(function
(lambda ( a b c )
(if
(or
(< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
b 32
)
)
)
(cons nil l) l (append (cdr l) (list nil))
)
)
")"
)
)
)
(vl-string->list s)
)
)
;(defun ah:sheetupdate1 (ss1 lay plotabs tabname dwgname)
(defun ah:sheetupdate1 ()
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
(setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq title "Please enter dwg number")
(setq width " edit_width = 12;")
(setq limit " edit_limit = 9;")
(ah:getval title width limit)
(setq dwgname item)
(setq title "Please enter version for all sheets <Cr> no change")
(setq width " edit_width = 8;")
(setq limit " edit_limit = 5;")
(ah:getval title width limit)
(setq newstr4 item)
(princ "0")
(setq len (length plotabs))
(setq x 0)
(setq bname "DA1DRTXT")
(repeat len
(setq tabname (nth x plotabs))
(if (/= tabname "Model")
(progn
(setvar "ctab" tabname)
(setq ss1 (ssget "x"(list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname))))
(setq dwgnum (Lm:parsenumbers tabname))
(setq sheetnum (car dwgnum))
(setq oldtag1 "SHT_NO") ;attribute tag name
(setq newstr1 (rtos sheetnum 2 0))
(setq oldtag2 "DRG_NO") ;attribute tag name
(setq oldtag3 "PROJ_NO") ;attribute tag name
(setq newstr3 dwgname)
(setq oldtag4 "REV_NO") ;attribute tag name
; if less than 10
(if (< (car dwgnum) 10.0)
(setq newstr2 (strcat dwgname "-D0"(rtos sheetnum 2 0)))
(setq newstr2 (strcat dwgname "-D"(rtos sheetnum 2 0)))
)
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1)
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2)
) ; end if
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3)
) ; end if
(if (and (/= newstr4 nil) (= oldtag4 (strcase (vla-get-tagstring att))) )
(vla-put-textstring att newstr4)
) ; end if
) ; end foreach
) ; end progn
) ; end if
(setq x (+ x 1))
) ; end repeat
(setq ss1 nil)
) ; end defun ah
(ah:sheetupdate1)
(princ)
抱歉回复太慢，一直很忙。
感谢Bigal的Lisp程序，不幸的是，它无法工作。已经给了几百张图纸重新编号，所以我迫切需要一个脚本/lisp来自动执行。
总而言之：我需要更改整个图纸系列的页码和图纸编号，以便按升序排列。
例如：对于页码：“第1页，共200页”，“第2页，共200页”等。
图纸编号：“xxxx\u xxxx\u 100\u 001”、“xxxx\u xxxx\u 100\u 002”等。
以下是用于更改标题栏中的值的示例脚本：
这是标题栏的图片，包括所有属性标记。
提前感谢！ 现成的并不存在，因为每个块都有不同的名称和不同的属性标记名称。
因此，首先您必须更改上面代码中的块名，它是DA1DRTXT
属性标签需要更改为“DRG_NO”）；属性标签名，到你的BDR\U DWGTITLE1等等，然后你的好的方式。
再次张贴你的标题栏，这是一个5分钟的工作 这里是一个快速剪切粘贴更改yourblockname
; changes to issued for construction
(vl-load-com)
(setq oldtag1 "BDR_JOBTITLE1") ;attribute tag name
(setq newstr1 "Job title 1")
(setq oldtag2 "BDR_JOBTITLE1");attribute tag name
(setq newstr2 "Job title 2")
(setq x 1) ; sheet 1
(setq ss1 (ssget "x"'((0 . "INSERT") (2 . "Yourblockname"))))
(setq inc (sslength ss1)) ; this is the total number of sheets +1
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1)
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2)
) ; end if
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att x)
) ; end if
) ; end for
(setq x (+ x 1))
) ;end repeat
(setq ss1 nil)
; (setq ss2 nil)
(princ)
页:
1
[2]