用于更改标题BL的lISP

DEEPAKRAJ · 发表于 2022-7-6 07:13:19

先生们，

我有100多个，我应该把标题改成100多个。块说明、修订、drwn、chkd、设计、批准等。。。
我可以Lisp程序吗。我正在使用acad版本12
样品图纸

irneb · 发表于 2022-7-6 07:25:15

您需要发送一个示例DWG，以便我们知道如何创建TB。只有这样，我们才能说出Lisp程序应该是什么样子，或者是否可能。

Dadgad · 发表于 2022-7-6 07:38:29

我不确定李·麦克的哪一个Lisp程序最适合你正在做的事情，但你可能想考虑一下这一个
http://www.lee-mac.com/bfind.html，或者可能http://www.lee-mac.com/batte.html . 他的网站是一座金矿
智能编程，非常慷慨地提供给公众。

谢谢李！

DEEPAKRAJ · 发表于 2022-7-6 07:47:13

我无法发送标题栏本身，因为我有安全问题。所以我根据属性分解了块

BIGAL · 发表于 2022-7-6 07:52:22

这里有一个例子，这确实是“发布建设”有多个例子改变标题栏的细节她在论坛上你需要做一点搜索。你需要一个脚本来完成100+的任务。下面的第二篇文章阅读了可能也有用的布局名称。

copy

; 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"))))   ; title block is 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)

阅读版式编号和最新标题栏

copy

; change the 410 to layout name
;;-------------------=={ Parse Numbers }==--------------------;;
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  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 (/= version 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)

ReMark · 发表于 2022-7-6 07:58:31

标题栏上的安全问题？你是回来为中情局工作还是这次是军情五处？

没有人会偷走你的标题栏。我们需要这些信息，以便帮助您解决问题。如果你没有或不能提供所要求的问题，那么你就降低了成功的机会。这就是你想要的吗？

Bill Tillman · 发表于 2022-7-6 08:08:31

我想它叫军情六处。。。或者现在可能是军情八处。

我能理解安全。。。与我工作的一些客户相比，他们的安全性并没有那么高，只是不希望他们的任何东西出现在公共领域。嘿，他们写支票，所以谁说他们错了。

我认为李在他的网站上有一些这样的例行公事。进行搜索可能会得到其他你想要的结果。

几个月前，我在这个论坛上也发现了这一点。这有点复杂，但我能够解决它来做我需要的事情，那就是批量处理整个文件夹中的dwg文件，并在每个文件夹中进行统一的更改。手动操作需要几天的时间，并将其减少到15-20分钟左右。YMMV公司

更新：我很抱歉，但我认为我给的链接不是我找到的正确帖子。然而，这很相似，当我阅读那篇文章时，代码似乎有问题。如果您没有找到要查找的内容，我可以发布我使用的代码，该代码打开文件夹中的所有文件，将单位更改为英寸，并在图形的“单位”部分中设置一些其他统一特性。该代码很容易适应其他任务。

irneb · 发表于 2022-7-6 08:21:07

从分解后的TB来看，似乎只显示了5条修订行。这些是最新的5个修订版吗？即，如果达到修订版#6，则省略第一个，并将其他修订版下移一个？

您希望应用于所有100多个DWG的更改是否始终相同？一、 e.您有一个新版本，需要加入所有图纸。或者每个图纸是否可能有不同的描述/图纸等。？

[编程交流] 用于更改标题BL的lISP

发表回复

精选推荐