- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Ok so I have found Lee Mac's brilliant Automatic labelling lisp at the link below
Automatically Label Attributes | Lee Mac Programming (lee-mac.com)
Now it doesn't quite work how I would like.
Instead of the number incrementing can it instead get the characters after the "-" in a layout tab?
Also can the suffix be made to increment?
eg his code goes 1a, 2a, 3a
We might have a layout labelled A2_1234-56, and one labelled A2_1234a-48
So on the first page the blocks would go P56a, P56b..., and on the second one they would go P48a, P48b...
His code is below, with some very minor changes from me.
;;---------------------=={ AutoLabel Attributes }==---------------------;;
;; ;;
;; This program will automatically populate a specific attribute tag ;;
;; with a unique label within a set of attributed blocks, renumbering ;;
;; if blocks are added, copied or erased. ;;
;; ;;
;; The program uses an Object Reactor to monitor modification events ;;
;; for the set of all attributed blocks with a block name matching ;;
;; a block name or wildcard pattern specified within the program ;;
;; source code. ;;
;; ;;
;; Following modification to any matching attributed block, a Command ;;
;; Reactor will trigger the program to automatically renumber a ;;
;; specific attribute tag held by all matching attributed blocks in ;;
;; the active layout of the drawing. ;;
;; ;;
;; The block references are numbered in the order in which they are ;;
;; encountered in the drawing database of the active drawing ;;
;; (that is, the order in which the blocks were created). ;;
;; ;;
;; The program also allows the user to specify a numbering prefix & ;;
;; suffix, the starting number for the numbering, and the number of ;;
;; characters to be used for fixed length numbering with leading zeros ;;
;; (i.e. if the numbering length is set to 2, the program will number ;;
;; the blocks 01,02,03,...,10,11,12). ;;
;; ;;
;; The autonumbering functionality is automatically enabled on drawing ;;
;; startup when the program is loaded, and may be subsequently enabled ;;
;; or disabled manually using the commands 'AUTOLABELON' & ;;
;; 'AUTOLABELOFF' respectively. ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright � 2011 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.0 - 2011-09-14 ;;
;; ;;
;; - First release. ;;
;;----------------------------------------------------------------------;;
;; Version 1.1 - 2015-09-20 ;;
;; ;;
;; - Program entirely rewritten. ;;
;; - Added callback function to handle command cancelled & command ;;
;; failed events when modifying autonumbered blocks. ;;
;; - Added the ability to specify a numbering prefix & suffix, ;;
;; specify a starting number, and use fixed length numbering ;;
;; (i.e numbering with leading zeros: 01,02,...,10). ;;
;; - Block Name & Attribute Tag parameters may now use wildcards to ;;
;; match multiple block names & tags (the first attribute tag which ;;
;; matches the wildcard pattern will be numbered). ;;
;; - Incorporated compatibility for Multiline Attributes. ;;
;;----------------------------------------------------------------------;;
;; Version 1.2 - 2015-09-27 ;;
;; ;;
;; - Program modified to only increment numbering counter if an ;;
;; attribute matching the target tag name is found. ;;
;; - Implemented compatibility for multileader blocks. ;;
;;----------------------------------------------------------------------;;
;; Version 1.3 - 2018-10-27 ;;
;; ;;
;; - Fixed bug in autolabel:getattributetagid function preventing ;;
;; numbering of multileader attributed blocks. ;;
;;----------------------------------------------------------------------;;
;; Version 1.4 - 2020-02-15 ;;
;; ;;
;; - Program modified to account for attributed MInsert Blocks. ;;
;;----------------------------------------------------------------------;;
(setq
;;----------------------------------------------------------------------;;
;; Settings ;;
;;----------------------------------------------------------------------;;
autolabel:blockname "PHOTOFRAME" ;; Name of block to be updated (not case-sensitive / may use wildcards)
autolabel:blocktag "PHREF" ;; Attribute tag to be updated (not case-sensitive / may use wildcards)
autolabel:prefix "P" ;; Numbering prefix (use "" for none)
autolabel:suffix "a" ;; Numbering suffix (use "" for none)
autolabel:start 1 ;; Starting number
autolabel:length 1 ;; Fixed length numbering (set to zero if not required)
autolabel:startup t ;; Enable on drawing startup (t=enable / nil=disable)
autolabel:objtype 3 ;; Bit-coded integer > 0 (1=attributed blocks; 2=multileader blocks)
;;----------------------------------------------------------------------;;
)
;;----------------------------------------------------------------------;;
;; Main Program ;;
;;----------------------------------------------------------------------;;
(defun autolabel:objectreactorcallback:renumberblocks ( own rtr arg )
(if (null autolabel:commandreactor)
(setq autolabel:commandreactor
(vlr-command-reactor "autolabel"
'(
(:vlr-commandended . autolabel:commandreactorcallback:renumberblocks)
(:vlr-commandcancelled . autolabel:commandreactorcallback:cancelled)
(:vlr-commandfailed . autolabel:commandreactorcallback:cancelled)
)
)
)
)
(princ)
)
(defun autolabel:commandreactorcallback:cancelled ( rtr arg )
(if (= 'vlr-command-reactor (type autolabel:commandreactor))
(progn
(vlr-remove autolabel:commandreactor)
(setq autolabel:commandreactor nil)
)
)
(princ)
)
(defun autolabel:commandreactorcallback:renumberblocks ( rtr arg / att blk idx num obj oid sel )
(if (= 'vlr-command-reactor (type autolabel:commandreactor))
(progn
(vlr-remove autolabel:commandreactor)
(setq autolabel:commandreactor nil)
)
)
(if (= 'vlr-object-reactor (type autolabel:objectreactor))
(vlr-remove autolabel:objectreactor)
)
(if
(and (not autolabel:undoflag)
(setq sel
(ssget "_X"
(append
(if (= 3 (logand 3 autolabel:objtype))
'((-4 . "<OR"))
)
(if (= 1 (logand 1 autolabel:objtype))
(list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
)
(if (= 2 (logand 2 autolabel:objtype))
'((0 . "MULTILEADER"))
)
(if (= 3 (logand 3 autolabel:objtype))
'((-4 . "OR>"))
)
(if (= 1 (getvar 'cvport))
(list (cons 410 (getvar 'ctab)))
'((410 . "Model"))
)
)
)
)
)
(progn
(setq num autolabel:start)
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
(if (setq att (autolabel:getattribute obj))
(progn
(vla-put-textstring att
(strcat
autolabel:prefix
(autolabel:padzeros (itoa num) autolabel:length)
autolabel:suffix
)
)
(setq num (1+ num))
(autolabel:addowner obj)
)
)
(if (and (= acblockcontent (vla-get-contenttype obj))
(wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
(setq oid (autolabel:getattributetagid blk))
)
(progn
(autolabel:setblockattributevalue obj oid
(strcat
autolabel:prefix
(autolabel:padzeros (itoa num) autolabel:length)
autolabel:suffix
)
)
(setq num (1+ num))
(autolabel:addowner obj)
)
)
)
)
)
)
(if (= 'vlr-object-reactor (type autolabel:objectreactor))
(vlr-add autolabel:objectreactor)
)
(princ)
)
(defun autolabel:commandreactorcallback:undocheck ( rtr arg )
(setq autolabel:undoflag (= (strcase (car arg) t) "undo"))
(princ)
)
(defun autolabel:commandreactorcallback:blockinserted ( rtr arg / att blk ent enx idx new num obj oid sel )
(if
(and
(not autolabel:undoflag)
(wcmatch (strcase (car arg) t)
(strcat
(if (= 1 (logand 1 autolabel:objtype)) "-insert,insert,executetool" "")
(if (= 3 (logand 3 autolabel:objtype)) "," "")
(if (= 2 (logand 2 autolabel:objtype)) "mleader" "")
)
)
(setq ent (entlast))
(setq new (vlax-ename->vla-object ent))
(setq enx (entget ent))
(or
(and
(= 1 (logand 1 autolabel:objtype))
(= "INSERT" (cdr (assoc 0 enx)))
(= 1 (cdr (assoc 66 enx)))
(wcmatch (autolabel:effectivename new) autolabel:blockname)
)
(and
(= 2 (logand 2 autolabel:objtype))
(= "MULTILEADER" (cdr (assoc 0 enx)))
(= acblockcontent (vla-get-contenttype new))
(wcmatch (strcase (vla-get-contentblockname new)) autolabel:blockname)
)
)
(setq sel
(ssget "_X"
(append
(if (= 3 (logand 3 autolabel:objtype))
'((-4 . "<OR"))
)
(if (= 1 (logand 1 autolabel:objtype))
(list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
)
(if (= 2 (logand 2 autolabel:objtype))
'((0 . "MULTILEADER"))
)
(if (= 3 (logand 3 autolabel:objtype))
'((-4 . "OR>"))
)
(if (= 1 (getvar 'cvport))
(list (cons 410 (getvar 'ctab)))
'((410 . "Model"))
)
)
)
)
)
(progn
(setq num (1- autolabel:start))
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
(if (autolabel:getattribute obj)
(setq num (1+ num))
)
(if (and (= acblockcontent (vla-get-contenttype obj))
(wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
(autolabel:getattributetagid blk)
)
(setq num (1+ num))
)
)
)
(if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
(if (setq att (autolabel:getattribute new))
(progn
(vla-put-textstring att
(strcat
autolabel:prefix
(autolabel:padzeros (itoa num) autolabel:length)
autolabel:suffix
)
)
(autolabel:addowner new)
)
)
(if (setq oid (autolabel:getattributetagid (vla-get-contentblockname new)))
(progn
(autolabel:setblockattributevalue new oid
(strcat
autolabel:prefix
(autolabel:padzeros (itoa num) autolabel:length)
autolabel:suffix
)
)
(autolabel:addowner new)
)
)
)
)
)
(princ)
)
(defun autolabel:addowner ( obj )
(if
(and
(= 'vlr-object-reactor (type autolabel:objectreactor))
(not (member obj (vlr-owners autolabel:objectreactor)))
)
(vlr-owner-add autolabel:objectreactor obj)
)
)
(defun autolabel:getattribute ( blk )
(if (wcmatch (strcase (autolabel:effectivename obj)) autolabel:blockname)
(vl-some
'(lambda ( att )
(if (wcmatch (strcase (vla-get-tagstring att)) autolabel:blocktag) att)
)
(vlax-invoke blk 'getattributes)
)
)
)
(defun autolabel:getattributetagid ( blk )
(eval
(list 'defun 'autolabel:getattributetagid '( blk / itm tmp )
(list 'if
'(setq itm (assoc (strcase blk) autolabel:attributetagids))
'(cdar (vl-member-if '(lambda ( att ) (wcmatch (car att) autolabel:blocktag)) (cdr itm)))
(list 'progn
(list 'vlax-for 'obj (list 'vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 'blk)
'(if
(and
(= "AcDbAttributeDefinition" (vla-get-objectname obj))
(= :vlax-false (vla-get-constant obj))
)
(setq tmp
(cons
(cons
(strcase (vla-get-tagstring obj))
(autolabel:objectid obj)
)
tmp
)
)
)
)
'(setq autolabel:attributetagids (cons (cons (strcase blk) tmp) autolabel:attributetagids))
'(autolabel:getattributetagid blk)
)
)
)
)
(autolabel:getattributetagid blk)
)
(defun autolabel:setblockattributevalue ( obj idx str )
(if (vlax-method-applicable-p obj 'setblockattributevalue32)
(defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
(defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue obj idx str))
)
(autolabel:setblockattributevalue obj idx str)
)
(defun autolabel:objectid ( obj )
(if (vlax-property-available-p obj 'objectid32)
(defun autolabel:objectid ( obj ) (vla-get-objectid32 obj))
(defun autolabel:objectid ( obj ) (vla-get-objectid obj))
)
(autolabel:objectid obj)
)
(defun autolabel:effectivename ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun autolabel:effectivename ( obj ) (strcase (vla-get-effectivename obj)))
(defun autolabel:effectivename ( obj ) (strcase (vla-get-name obj)))
)
(autolabel:effectivename obj)
)
(defun autolabel:padzeros ( str len )
(if (< (strlen str) len)
(autolabel:padzeros (strcat "0" str) len)
str
)
)
(defun autolabel:disable ( key )
(foreach grp (vlr-reactors :vlr-command-reactor :vlr-object-reactor)
(foreach obj (cdr grp)
(if (= key (vlr-data obj)) (vlr-remove obj))
)
)
(setq autolabel:undoflag nil
autolabel:objectreactor nil
autolabel:commandreactor nil
)
)
(defun autolabel:enable ( key )
(autolabel:disable key)
(vlr-set-notification
(setq autolabel:objectreactor
(vlr-object-reactor nil key
'(
(:vlr-erased . autolabel:objectreactorcallback:renumberblocks)
(:vlr-copied . autolabel:objectreactorcallback:renumberblocks)
(:vlr-unerased . autolabel:objectreactorcallback:renumberblocks)
)
)
)
'active-document-only
)
(vlr-set-notification
(vlr-command-reactor key
'(
(:vlr-commandwillstart . autolabel:commandreactorcallback:undocheck)
(:vlr-commandended . autolabel:commandreactorcallback:blockinserted)
)
)
'active-document-only
)
(autolabel:commandreactorcallback:renumberblocks nil nil)
(princ
(strcat
"\nAutonumbering enabled for tags matching \""
autolabel:blocktag
"\" within "
(if (= 1 (logand 1 autolabel:objtype)) "blocks" "")
(if (= 3 (logand 3 autolabel:objtype)) " & " "")
(if (= 2 (logand 2 autolabel:objtype)) "multileaders" "")
" matching \""
autolabel:blockname
"\"."
)
)
(princ)
)
;;----------------------------------------------------------------------;;
;; Loading Expressions ;;
;;----------------------------------------------------------------------;;
( (lambda nil
(vl-load-com)
(cond
( (vl-some
(function
(lambda ( val par )
(if (/= 'str (type val))
(princ (strcat "\nThe " par " parameter must be a valid string."))
)
)
)
(list
autolabel:blockname
autolabel:blocktag
autolabel:prefix
autolabel:suffix
)
'(
"Block Name"
"Attribute Tag"
"Numbering Prefix"
"Numbering Suffix"
)
)
)
( (/= 'int (type autolabel:start))
(princ "\nThe Starting Number parameter must hold an integer value.")
)
( (/= 'int (type autolabel:length))
(princ "\nThe Fixed Length Numbering parameter must hold an integer value.")
)
( (not
(and
(= 'int (type autolabel:objtype))
(< 0 autolabel:objtype)
(< 0 (logand 3 autolabel:objtype))
)
)
(princ "\nThe Object Type parameter must hold a bit-coded integer value between 1 & 3.")
)
( (setq autolabel:blockname (strcase autolabel:blockname)
autolabel:blocktag (strcase autolabel:blocktag)
)
(defun c:autolabelon nil
(autolabel:enable "autolabel")
)
(defun c:autolabeloff nil
(autolabel:disable "autolabel")
(princ "\nAutonumbering disabled.")
(princ)
)
(if autolabel:startup (autolabel:enable "autolabel"))
)
)
(princ)
)
)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Solved! Go to Solution.