Leaderboard

Checking in to celebrate my one year in badge! This site has been so beneficial to me it's awesome! Thanks all!

A fence selection will ensure that your selection set is created in the order that the fence is created. That way, you have the right next's and previous'. However, if you want to click them one at a time as stated in the OP, then this will do for now. Though I don't believe it's the most efficient idea around: (defun c:foo ( / *error* acadobj activeundo adoc blk blk_curr blk_prev enx pck spc) ;; --- My Usual Intro --- ;; (defun *error* ( msg ) (vla-EndUndoMark adoc) (if pck (setvar "PICKADD" pck)) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) ) (if (= (getvar 'cvport) 1) (setq spc (vla-get-Block (vla-get-ActiveLayout adoc))) (setq spc (vla-get-ModelSpace adoc)) ) (setq pck (getvar "PICKADD")) (setvar "PICKADD" 2) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) ;; --- My Usual Intro --- ;; (while (progn (setvar "errno" 0) (initget "Exit") (setq blk (entsel "\nSelect block in sequence [Exit] <exit>: ")) (cond ( (= (getvar "errno") 7) (princ "\nNothing selected.")) ( (member blk '("Exit" nil)) (setq blk nil)) ( (not (wcmatch (cdr (assoc 0 (setq blk (car blk) enx (entget blk)))) "INSERT")) (princ "\nObject is not a block") ) ( (not (= (cdr (assoc 66 enx)))) (princ "\nBlock does not contain any attributes") ) ( (not blk_prev) (setq blk_prev (vlax-ename->vla-object blk))) ( t (setq blk_curr (vlax-ename->vla-object blk)) (LM:vl-setattributevalue blk_prev "Next" (cond ((LM:vl-getattributevalue blk_curr "ID")) ("No ID Found"))) (LM:vl-setattributevalue blk_curr "Previous" (cond ((LM:vl-getattributevalue blk_prev "ID")) ("No ID Found"))) (setq blk_prev blk_curr) ) ) ) ) ;; --- My Usual Ending --- ;; (setvar "PICKADD" pck) (if (not activeundo) (vla-EndUndoMark adoc)) (princ) ;; --- My Usual Ending --- ;; ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) (vl-load-com)

You can add the new path to the Support File Search Path on all computers with AutoCAD. REDIR Express Tool in a script file.

No worries! Just trying to help out

I don't understand? Your function and my modification return the same thing? The valid pattern is set outside of the function? (and (tblsearch "BLOCK" "ANCHOR") (tblsearch "BLOCK" "RNOTES") (> (length (pjk-blockfind "DTBLK@, DTBLK@@")) 0) ) FWIW (setq bl '("A" "B" "C") pat "A,C" ) ;; This (vl-remove-if '(lambda (y) (= y nil)) (mapcar '(lambda (x) (if (wcmatch x pat) x nil ) ) bl ) ) ;; ("A" "C") ;; Is the same as this? (vl-remove-if-not '(lambda (x) (wcmatch x pat)) bl) ;; ("A" "C")

@pkenewell FWIW you could do your filtering while grabbing the name rather than using vl-remove-if on the whole list at the end. (defun pjk-blockfind (pat / bl) (vlax-for x (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (and (wcmatch (vla-get-name x) pat) (setq bl (cons (vla-get-name x) bl))) ) bl )