创建属性自动编号

James281 · 发表于 2022-7-5 18:31:24

我已经离开ACAD好几年了。我记得有一个类似的lisp或VBA，它允许我选择块，然后按指定的增量重新编号。我喜欢这个代码，但是，我有几个问题

1）有没有办法删除“标记”特定的代码行，以便我可以在不同的块上使用
2）有没有办法选择顺序或选择所有相同的块，并按插入顺序更新属性

我下载了这个lisp，它可以正常工作，但改变了我块中的字体类型；http://www.cadstudio.cz/en/download.asp?file=InsertC

最后，我记得一种方法，当我插入块时，块会自动增加数字。

很抱歉问了这么多奇怪的问题，已经两年多了。

Lee Mac · 发表于 2022-7-5 18:33:46

谢谢LeeMac
我进行了粗略修改，以允许：
[列表]

增量选择

前缀和后缀
[/列表]

copy


(defun c:AttNum ( / *error* _StartUndo _EndUndo doc ss lst ) (vl-load-com)
 ;; © Lee Mac 2010
 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )
 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )
 (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object)))  
 (setq *tag (cond ( *tag ) ( "TAG1" ))
       
 )
 (setq *tag
   (strcase
     (cond
       (
         (eq ""
           (setq tmp
             (getstring
               (strcat "\nSpecify Attribute Tag to be Numbered <"
                 (setq *tag
                   (cond ( *tag ) ( "TAG1" ))
                 )
                 "> : "
               )
             )
           )
         )
         *tag
       )
       ( tmp )
     )
   )
 )
 (setq *num
   (1-
     (cond
       (
         (getint
           (strcat "\nSpecify Starting Number <"
             (itoa
               (setq *num
                 (1+
                   (cond ( *num ) ( 0 ))
                 )
               )
             )
             "> : "
           )
         )
       )
       ( *num )
     )
   )
 )
 (if (ssget "_:L" '((0 . "INSERT") (66 . 1)))
   (progn      
     (vlax-for o (setq ss (vla-get-ActiveSelectionSet doc))
       (setq lst
         (cons
           (cons (vlax-get o 'InsertionPoint) o) lst
         )
       )
     )
     (vla-delete ss)
     (_StartUndo doc)
     (mapcar
       (function
         (lambda ( block )
           (mapcar
             (function
               (lambda ( attrib )
                 (if (eq *tag (strcase (vla-get-TagString attrib)))
                   (vla-put-TextString attrib (setq *num (1+ *num)))
                 )
               )
             )
             (vlax-invoke (cdr block) 'GetAttributes)
           )
         )
       )
       (vl-sort lst
         (function
           (lambda ( a b ) (> (cadar a) (cadar b)))
         )
       )
     )
     (_EndUndo doc)
   )
 )
 (princ)
)

baker · 发表于 2022-7-5 18:40:07

SunnyTurtle · 发表于 2022-7-5 18:42:25

Thank LeeMac
I crudely modified to allow for:

increment selection
prefix & suffix

copy

(defun c:AttNum        (/             *error*         MakeVariant Itemp         MakeSelectionSet         DOC             OBJ         OBJECTLIST  SS                 TAG             UFLAG        ) (vl-load-com) ;; Lee Mac  ~  15.04.10 (setq tag "SM_TAG") (defun *error* (msg)   (if        uFlag     (vla-EndUndoMark(vla-get-ActiveDocument  (vlax-get-acad-object))     )   )   (or        (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")(princ (strcat "\n** Error: " msg " **"))   )   (princ) ) (defun MakeVariant (data datatype)   (vlax-make-variant     (vlax-safearray-fill(vlax-make-safearray  (eval datatype)  (cons 1 (length data)))data     )   ) ) (defun Itemp (collection item / result)   (if        (not (vl-catch-all-error-p       (setq result              (vl-catch-all-apply                (function vla-item)                (list collection item)              )       )     ))     result   ) ) (defun MakeSelectionSet (ref / SelSets SelSet)   (if        (setq SelSet       (itemp         (setq SelSets                (vla-get-SelectionSets                  (vla-get-ActiveDocument                    (vlax-get-acad-object)                  )                )         )         ref       ))     (vla-delete SelSet)   )   (vla-add SelSets ref) ) (setq        *start (cond   (*start)   (1) ) );;;  (setq *start;;;    (1-;;;      (cond;;;        (  (getint;;;             (strcat "\nSpecify Starting Number  : ";;;             );;;           );;;        );;;        (*start);;;      );;;    );;;  ) (setq        startnum (cond   (startnum)   (1) ) )  (setq        startnum (cond   ((getint      (strcat "\nSpecify Starting Number  : "      )    )   )   (startnum) ) )  (setq        INC (getint   (strcat "\nSpecify Increment "   ) ) )  (setq *start (- startnum INC))        ; lm var set  (setq        prefix (getstring   (strcat "\nSpecify Prefix"   ) ) ) (setq        sufix (getstring   (strcat "\nSpecify Sufix"   ) ) )                                ;                                                        rc (if (zerop(vla-get-Count  (setq        ss         (vla-get-PickFirstSelectionSet           (setq doc                  (vla-get-ActiveDocument                    (vlax-get-acad-object)                  )           )         )  ))     )   (progn     (setq ss (MakeSelectionSet "Tree_SS"))     (vla-SelectOnScreenss(MakeVariant '(0 66) vlax-vbInteger)(MakeVariant '("INSERT" 1) vlax-vbVariant)     )   ) ) (if (not(zerop  (vla-get-Count ss))     )   (progn     (setq UFlag     (not       (vla-StartUndoMark doc)     )     )     (vlax-for        obj ss(setq ObjectList       (cons         (cons obj               (vlax-safearray->list                 (vlax-variant-value                   (vlax-get-property obj 'InsertionPoint)                 )               )         )         ObjectList       ))     )     (vla-delete ss)     (mapcar(function  (lambda (block)    (mapcar      (function        (lambda        (attribute)          (if (eq tag (vla-get-TagString attribute))            (vl-catch-all-apply              (function vla-put-TextString)              (list attribute                    (strcat prefix                            (itoa (setq *start (+ INC *start)))                            sufix                    )              )                        ;rc            )          )        )      )      (vlax-invoke block 'GetAttributes)    )  ))(mapcar        (function car)        (vl-sort ObjectList                 (function                   (lambda (point1 point2)                     (< (caddr point1) (caddr point2))                   )                 )        ))     )     (setq UFlag     (vla-EndUndoMark doc)     )   ) ) (princ))

[编程交流] 创建属性自动编号

发表回复

精选推荐