I'm not able to code in lisp and I would really appreciate any help, so here goes: I would like to incorporate the ability for the GATTE2 list routine, written by Steve K, to differentiate dynamic block instances.
Here's the GATTE2 lisp routine:
;| ;;
GATTE2: By Steve K (Date 10/2009) ;;
v1.0 Initial Release ;;
v1.01 Minor amendments (nothing externally noticable) ;;
v1.02 Localised variables & Working again.. ;;
;;
Description: A drawback of the standard GATTE command is that the user ;;
can not chose which layouts to replace text on (it will ;;
overwrite the text on every layout). ;;
GATTE2 gives the user the option to select which layouts ;;
to apply the attribute change to. ;;
|;
;;
(defun c:gatte2(/ *error* en obj doc tag atts attstr txtstr tablst laystr count
blkObj blkName sel)
(vl-load-com)
; Error Handler (Lee Mac's) ;
(defun *error* (err)
(if doc (vla-EndUndoMark doc))
(if (not (wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n** Error: " err " **")))
(princ))
; Get Layout Name Function ;
; @param An object. ;
; @return Layout Name object is on. ;
(defun getlayout (Obj)
(vla-get-Name
(vla-get-layout
(vla-objectidtoobject
(vla-get-ActiveDocument
(vlax-get-acad-object))
(vla-get-ownerid Obj)))))
; Main Process ;
(Cond ((not (setq en (nentsel)))
(princ "\nNothing Selected."))
((and (not (= (length en) 4))
(not (eq (cdr (assoc 0 (entget (setq en (car en))))) "ATTRIB")))
(princ "\nEntity not an Attribute or Block."))
((if (listp en)
(progn
(setq blkObj (vlax-ename->vla-object (car (nth 3 en))))
(if (setq atts (vlax-invoke blkObj 'getAttributes))
(progn
(foreach att atts
(if attstr
(setq attstr (strcat attstr " " (vla-get-tagstring att)))
(setq attstr (vla-get-tagstring att))))
(while (not (member (setq tag (strcase (getstring (strcat
"\nKnown tag names for block: " attstr
"\nEnter an attribute name: "))))
(mapcar 'vla-get-tagstring atts)))
(princ "Entry not an Attribute.")
)
(setq obj (nth (vl-position tag (mapcar 'vla-get-tagstring atts)) atts))
nil
)
T
)
)
(not (setq obj (vlax-ename->vla-object en)))
)
(princ "\nNo Tags Exist.")
)
((not (setq tablst (GetTabList)))
(princ "\nNo Tabs Selected."))
( T; Else Proceed
(setq count 0
doc (vla-get-activedocument (vlax-get-acad-object))
blkName (vla-get-name
(vla-ObjectIdtoObject doc
(vla-get-OwnerId Obj))))
(princ (strcat "\nBlock Name: " blkName " \tAttribute tag: " (vla-get-tagstring obj)))
(vla-StartUndoMark doc)
(setq txtstr (getstring T "\nEnter new Text String: "))
(setq laystr (car tablst))
(foreach lay (cdr tablst)
(setq laystr (strcat laystr (chr 44) lay))
)
(if (ssget "_X" (list (cons 0 "insert") (cons 2 blkName) (cons 410 laystr) (cons 67 1)))
(progn
(princ (strcat "\nThe following attributes were changed to \"" txtstr "\".."))
(vlax-for bl (setq sel (vla-get-activeselectionset doc))
(foreach att (vlax-invoke bl 'getAttributes)
(if (eq (vla-get-tagstring att) (vla-get-tagstring obj))
(progn
(setq count (1+ count))
(princ (strcat "\nLayout: " (getlayout bl) "\tOld Text: " (if (eq (vla-get-textstring att) "")
"*empty*" (vla-get-textstring att))))
(vla-put-textstring att txtstr))
)
)
)
(vla-delete sel)
(princ (strcat "\nModified " (itoa count) " attributes total.\n"))
(vla-EndUndoMark doc)
)(princ "\nNo Blocks Found."))
))
(princ)
)
;;
;| End: GATTE2 ;;
|;
;; CAB's Get Layouts Program ;;
;;
(defun GetTabList (/ dclfile dcl# layouts ptr tablist)
(setq dclfile "LayoutSelect.dcl")
(cond
((< (setq dcl# (load_dialog dclfile)) 0) ; Error
(prompt (strcat "\nCannot load " dclfile "."))
)
((not (new_dialog "layoutselect" dcl#)) ; Error
(prompt (strcat "\nProblem with " dclfile "."))
)
(t ; No DCL problems: fire it up
(setq layouts (orderedLayoutList))
(start_list "layouts")
(foreach one layouts
(add_list one)
)
(end_list)
(action_tile "layouts" "(setq ptr $value)")
(action_tile "ok" "(done_dialog 5)")
(action_tile "cancel" "(done_dialog 1)")
(setq action (start_dialog))
(unload_dialog dcl#)
(if (and ptr (= action 5)) ; get the list of selections to list of numbers
(setq ptr (read (strcat "(" ptr ")"))
tablist (mapcar '(lambda (x) (nth x layouts)) ptr))
)
) ; end cond T
) ; end cond
tablist
)
;;
;; ;;
;; OrderedLayoutList: Similar to (layoutlist) except returns list that is ;;
;; ordered by current tab order (not alphabetically) ;;
;;
(defun orderedLayoutList (/ laylst)
(vl-load-com)
(vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(setq laylst (cons lay laylst))
)
(cdr (mapcar 'vla-get-name (vl-sort laylst
(function
(lambda (a b)
(< (vla-get-taborder a)(vla-get-taborder b))
)))))
)
;;
;; ;;
I saw a snippet from another board member's post that could differentiate between the different dynamic block instances, I believe this is it:
(defun c:FID (/ Realss Sel Obj ss BlkName tempEnt)
(setq Realss (ssadd))
(if
(and
(setq Sel (entsel "\nSelect block to select likewise: "))
(setq Obj (vlax-ename->vla-object (car Sel)))
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(setq ss (ssget "X" '((0 . "INSERT"))))
(setq BlkName (vla-get-EffectiveName Obj))
(progn
(while (setq tempEnt (ssname ss 0))
(if (= BlkName (vla-get-EffectiveName (vlax-ename->vla-object tempEnt)))
(ssadd tempEnt Realss)
)
(ssdel tempEnt ss)
)
(> (sslength Realss) 0)
)
)
(progn
(sssetfirst nil Realss)
(prompt (strcat "\n Block selected: " (itoa (sslength Realss))))
)
(prompt "\n No likeness block selected.")
)
(princ)
)
Can the second bit of code be incorporated into the first?
Thanks and have a good one,
Robert
