Automatically Label Attributes

Function Syntax	-None-
Current Version	1.0
Download	AutoLabelAttributesV1-0.lsp
View HTML Version	AutoLabelAttributesV1-0.html

ليسب اخر http://www.cadstudio.cz/en/download.asp?file=InsertC

Free applications and CAD utilities (mostly our freeware)

CAD Utilities
--
	InsertC + BlockC - insert new (or renumber existing) blocks with incrementing numbers in attributes (incremental numbering, counter)

صيغة اخري الليسب

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
fLst blLst blSet aName sLst lZer aStr)
(vl-load-com)
(if
(and
(setq stStr(getstring "\nSpecify start number: "))
(setq stNum(atoi stStr))
(setq nLen(strlen stStr))
); end and
(progn
(if
(and
(setq cAtr(nentsel "\nPick attribute > "))
(= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
); end and
(progn
(setq blName
(vla-get-Name
(vla-ObjectIDToObject
(vla-get-ActiveDocument
(vlax-get-acad-object))
(vla-get-OwnerID
(vlax-ename->vla-object(car cAtr)))))
fLst(list '(0 . "INSERT")(cons 2 blName))
aName(cdr(assoc 2 dLst))
); end setq
(princ "\n<<< Select blocks to number >>> ")
(if
(setq blSet(ssget fLst))
(progn
(setq sLst
(mapcar 'vlax-ename->vla-object
(mapcar 'car
(vl-sort
(vl-sort
(mapcar '(lambda(x)(list x(cdr(assoc 10(entget x)))))
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex blSet))))
'(lambda(a b)(<(caadr a)(caadr b))))
'(lambda(a b)(>(cadadr a)(cadadr b)))))))
(foreach i sLst
(setq lZer "")
(repeat(- nLen(strlen(itoa stNum)))
(setq lZer(strcat lZer "0"))
); end repeat
(setq atLst
(vlax-safearray->list
(vlax-variant-value
(vla-GetAttributes i))))
(foreach a atLst
(if
(= aName(vla-get-TagString a))
(vla-put-TextString a
(strcat lZer(itoa stNum)))
); end if
); end foreach
(setq stNum(1+ stNum))
); end foreach
); end progn
(princ "\nEmpty selection! Quit. ")
); end if
); end progn
(princ "\nThis isn't attribute! Quit. ")
); end if
); end progn
(princ "\nInvalid start number! Quit. ")
); end if
(princ)
); end of c:mnum