Message 1 of 4
Copy Attribute Value as Field
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Does anyone know of a routine to copy a block attribute to multiple user selected block attributes as a field (%<\\AcObjProp Object(%<\\_ObjId #########>%).TextString>%)?
@Lee_MacCopyFieldV1-1.lsp is the closest routine I've come across to what I'm looking for. However the initial attribute selection has to be a field. I would like to select a blocks text/mtext attribute value initially, I would also like to be able to switch to other layouts for placement selections.
;;--------------------------=={ Copy Field }==--------------------------;;
;; ;;
;; This program enables the user to copy a field expression from a ;;
;; selected source object to multiple destination objects in a ;;
;; drawing. ;;
;; ;;
;; Upon issuing the command syntax 'copyfield' at the AutoCAD ;;
;; command-line, the user is prompted to select an annotation object ;;
;; (Text, MText, Attribute, Multileader, Dimension) containing a ;;
;; field expression to be copied. ;;
;; ;;
;; Following a valid response, the user may then copy the field to ;;
;; multiple selected destination objects in the drawing. ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.0 - 2013-07-14 ;;
;; ;;
;; - First release. ;;
;;----------------------------------------------------------------------;;
;; Version 1.1 - 2017-06-13 ;;
;; ;;
;; - Updated LM:fieldcode function to account for field expressions ;;
;; greater than 250 characters in length. ;;
;;----------------------------------------------------------------------;;
(defun c:copyfield ( / *error* select src )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun select ( msg fun / ent rtn )
(while
(progn (setvar 'errno 0) (setq ent (nentsel msg))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'list (type ent))
(cond
( (progn
(if (= 4 (length ent))
(setq ent (last (last ent)))
(setq ent (car ent))
)
(not (wcmatch (cdr (assoc 0 (entget ent))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION"))
)
(princ "\nInvalid object selected.")
)
( (not (setq rtn ((eval fun) ent))))
)
)
)
)
)
rtn
)
(if
(setq src
(select "\nSelect source field: "
(function
(lambda ( ent )
(cond ((LM:fieldcode ent)) ((not (princ "\nSelected object does not contain a field."))))
)
)
)
)
(progn
(LM:startundo (LM:acdoc))
(select "\nSelect destination object <Exit>: "
(function
(lambda ( ent / obj )
(cond
( (null (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent))))
(princ "\nSelected object is on a locked layer.")
)
( (vlax-property-available-p obj 'textoverride t)
(vla-put-textoverride obj src)
(command "_.updatefield" ent "")
)
( (vlax-property-available-p obj 'textstring t)
(vla-put-textstring obj src)
(command "_.updatefield" ent "")
)
)
nil
)
)
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; Field Code - Lee Mac
;; Returns the field expression associated with an entity
(defun LM:fieldcode ( ent / replacefield replaceobject fieldstring enx )
(defun replacefield ( str enx / ent fld pos )
(if (setq pos (vl-string-search "\\_FldIdx" (setq str (replaceobject str enx))))
(progn
(setq ent (assoc 360 enx)
fld (entget (cdr ent))
)
(strcat
(substr str 1 pos)
(replacefield (fieldstring fld) fld)
(replacefield (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
)
)
str
)
)
(defun replaceobject ( str enx / ent pos )
(if (setq pos (vl-string-search "ObjIdx" str))
(strcat
(substr str 1 (+ pos 5)) " "
(LM:ObjectID (vlax-ename->vla-object (cdr (setq ent (assoc 331 enx)))))
(replaceobject (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
)
str
)
)
(defun fieldstring ( enx / itm )
(if (setq itm (assoc 3 enx))
(strcat (cdr itm) (fieldstring (cdr (member itm enx))))
(cond ((cdr (assoc 2 enx))) (""))
)
)
(if (and (wcmatch (cdr (assoc 0 (setq enx (entget ent)))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION")
(setq enx (cdr (assoc 360 enx)))
(setq enx (dictsearch enx "ACAD_FIELD"))
(setq enx (dictsearch (cdr (assoc -1 enx)) "TEXT"))
)
(replacefield (fieldstring enx) enx)
)
)
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:ObjectID ( obj )
(eval
(list 'defun 'LM:ObjectID '( obj )
(if
(and
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:ObjectID obj)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: CopyField.lsp | Version 1.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"copyfield\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
