更改属性的Lisp例程

The Courage Dog · 发表于 2022-7-6 11:47:57

您好，有没有lisp例程可以为数百个图形一次更改一个属性标记值。假设我想在标题栏中将数百个图形的属性值修订版“0”更改为修订版“1”，而无需逐个打开它们。

非常感谢您的回复，谢谢。

Lee Mac · 发表于 2022-7-6 11:55:57

您可以使用ObjectDBX，但唯一的问题是图形缩略图丢失，并且已知在更改属性时会移动属性的位置。

因此，考虑到所有这些，也许一个脚本可能会更好。

todouble22 · 发表于 2022-7-6 12:01:38

在李的大力协助下，这一切都非常棒！它将在您指定的文件夹中的图形上执行，您可以编写脚本来执行您想要的操作。如果你需要它的脚本部分的帮助，发送它，但我认为你想从这里开始。
http://www.cadtutor.net/forum/showthread.php?t=43585&page=3

Lee Mac · 发表于 2022-7-6 12:06:27

谢谢你的插拔Todd

还有一件事——当你说“属性标记值”时，我假设你指的是属性值，而不是属性标记本身。

这是一个LISP，可以让你继续，如果你喜欢，可以在脚本中调用它：

copy


(defun AttribChng (blk tag val / ss)
 (vl-load-com)
 (mapcar (function set) '(blk tag)
         (mapcar (function strcase) (list blk tag)))
 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 (if (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) '(66 . 1)))
   (progn
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       (foreach att (vlax-invoke obj 'GetAttributes)
         (if (eq (strcase (vla-get-TagString att)) tag)
           (vla-put-TextString att val))))
     (vla-delete ss))
   (princ "\n** No Blocks Found **"))
 (princ))
(defun c:test nil
 (AttribChng "titleblock" "revision" "1")
 (princ))

The Courage Dog · 发表于 2022-7-6 12:10:01

我在一个图形中测试了你的lisp，它工作得很好。如何使用它，以使我不打开每个图形和运行lisp对每个图形。还有，我该如何在脚本中输入？对不起，我的Lisp程序不太好。

谢谢李·麦克。

Lee Mac · 发表于 2022-7-6 12:17:05

如果您要使用我的脚本编写器，正如todouble所链接的那样，您将使用脚本行：

copy


_.open *file* (load "C:\\Users\\The Courage Dog\\myLISP.lsp") (AttribChng "titleblock" "revision" "1") _.save _.close

其中filepath是LISP文件的位置。如果LISP在支持路径中，则只需：

copy


(load "myLISP.lsp")

让我知道你进展如何

The Courage Dog · 发表于 2022-7-6 12:22:02

对不起，我听不懂你的指示，你能简单地给我解释一下吗。。。。。这个想法是在不打开每个图形的情况下使用lisp，所有的数百个图形都会更改某些属性值。。。。再次抱歉。。

Lee Mac · 发表于 2022-7-6 12:29:08

不用抱歉，我会解释得更好一点

其想法是编写一个脚本，可以运行该脚本来更改图形中必要的属性值。

通常的方法是为要处理的每个图形编写一行脚本，例如，脚本可能看起来像：

copy


_.open "C:\Users\Lee Mac\Drawing1.dwg" (load "C:\\mylisp.lsp") (c:mylisp) _.save _.close
_.open "C:\Users\Lee Mac\Drawing2.dwg" (load "C:\\mylisp.lsp") (c:mylisp) _.save _.close
_.open "C:\Users\Lee Mac\Drawing3.dwg" (load "C:\\mylisp.lsp") (c:mylisp) _.save _.close

但是为了避免用户以这种方式构造脚本的每一行，我编写了一个LISP程序来为您编写脚本。

copy


(defun c:wScript (/ *error* Get_Subs Str-Break Str-Make DirDia
                   FILE FOLD FOLDER OFILE PATH SCRLINE SHELL STRLST)
 
 ;; Lee Mac  ~  11.01.10
 (vl-load-com)
 
 (setq *acad (cond (*acad) ((vlax-get-acad-object)))
       *doc  (cond (*doc)  ((vla-get-ActiveDocument *acad))))
 
 (or *def_opt* (setq *def_opt* "Yes"))
 
 (defun *error* (msg)
   (and ofile (close ofile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 (defun get_subs (folder / file)
   ;; CAB
   (mapcar
     (function
       (lambda (x) (setq file (strcat folder "\" x))
                   (cons file (apply (function append) (get_subs file)))))
       (cddr (vl-directory-files folder nil -1))))
 
 (defun Str-Break (str del / pos lst)
   ;; Lee Mac  ~  27.05.09
 (while (setq pos  (vl-string-search del str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 1 (strlen del)))))
 (reverse (cons str lst)))
 
 (defun Str-Make (lst del / str x)
   ;; Lee Mac  ~  29.12.09
   (setq str  (car lst))
   (foreach x (cdr lst) (setq str (strcat str del x)))
 str)
 
 (defun DirDia (msg dir flag)
   ;; Lee Mac  ~  07.06.09
   (setq Shell (vla-getInterfaceObject *acad "Shell.Application")
         Fold  (vlax-invoke-method Shell 'BrowseForFolder
                 (vla-get-HWND *acad) msg flag dir))
   (vlax-release-object Shell)
   (if Fold
     (progn
       (setq Path (vlax-get-property
                    (vlax-get-property Fold 'Self) 'Path))
       (vlax-release-object Fold)
       (and (= "\" (substr Path (strlen Path)))
            (setq Path (substr Path 1 (1- (strlen Path)))))))
   
   Path)
 ;;  --=={  Main Function  }==--
 
 (prompt "\n<< Enter Script Operations, use *file* for the Filename >>")
 
 (cond (  (zerop (strlen (setq scrline (getstring t "\n>> Script: "))))
          (princ "\n*Cancel*"))
       (  (< (length (setq StrLst (Str-Break scrline "*file*"))) 2)
          (princ "\n** Delimiter *file* not found in Script String **"))
       (  (not (and (setq Path (DirDia "Select Directory of Files on Which to Operate..." nil 512))
                    
                    (not (initget "Yes No"))
                    (setq *def_opt*
                      (cond ((getkword (strcat "\nProcess SubDirectories? <" *def_opt* "> : ")))
                            (*def_opt*)))
                    
                    (setq file (getfiled "Create Script File" (cond (*load*) ("")) "scr" 1))))
        
          (princ "\n*Cancel*"))
       (t (setq *load* file ofile (open file "w"))
          (foreach filepath (apply (function append)
                                   (vl-remove 'nil
                                     (mapcar
                                       (function
                                         (lambda (Path)
                                           (mapcar
                                             (function
                                               (lambda (File)
                                                 (strcat Path "\" File)))
                                             (vl-directory-files Path "*.dwg" 1))))
                                       (append (list Path)
                                               (apply (function append)
                                                      (if (= "YES" (strcase *def_opt*))
                                                        (Get_Subs Path)))))))
            (write-line (Str-Make strLst (strcat (chr 34) filepath (chr 34))) ofile))
          (setq ofile (close ofile))
          (princ "\n<< Script Written >>")))
 (princ))

该程序将提示输入脚本行，该行只是脚本的第一行，但您将使用*file*标记，而不是放置图形的文件路径。

因此：

copy


_.open *file* (load "C:\\mylisp.lsp) (c:mylisp) _.save _.close

然后，该程序将提示输入要处理的图形目录，以及是否也要包含子目录。

选择要将脚本写入的位置后，程序将构造一个脚本，可以运行该脚本来执行脚本行中列出的操作。

考虑到这一点，我们可以为您的情况编写一行脚本。

copy


_.open *file* (load "C:\\Users\\mylisp.lsp") (AttribChng "titleblock" "revision" "1") _.save _.close

其中“C:\\Users\\mylisp.lsp”指的是LISP文件所在的位置。

如果LISP文件位于ACAD支持路径中，则可以是：

copy


(load "mylisp.lsp")

编写脚本后，在ACAD中打开一个新图形，并在命令行中键入“script”。

选择我们刚刚编写的脚本，图形将被处理。

我希望这能澄清问题。

李

The Courage Dog · 发表于 2022-7-6 12:32:14

多好的解释啊。我相信我现在能听从你的指示。
你是个和蔼可亲的人。非常感谢李先生。你对我发布的每一条帖子都回答得很好。再次感谢您抽出时间。
我会尝试你的Lisp程序，让你知道任何更多的问题。。。

Lee Mac · 发表于 2022-7-6 12:39:57

谢谢

[编程交流] 更改属性的Lisp例程

发表回复

精选推荐