Help with LISP file

[StevJ]

Some time ago Lee Mac was kind enough to write this tool for me. It’s a neat program that draws a dashed box around certain attributed regions I make, based upon the shape of the region. He made it easy to modify, and I have - many times. It’s been a real time saver as a QA tool. Thanks again, Lee.

 

Change was inevitable, though, and now I find also a need to outline certain regions based not on shape or layer, but by an attribute tag named RIN that ends with PNG, as in ZX39EX84K43.PNG.

 

It doesn’t want to play. Just sits there and does nothing (like my wife’s cat).

The associated lines are red for easy finding, and if one of you kind folks would please give a look and tell me what I’ve done wrong, and maybe kick me in the right direction, I’d be greatful for the assist.

 

Thanks,

Steve

 

;;;
;;; Crafted by Lee Mac at cadtutor.net 14 May 2009
;;; http://www.cadtutor.net/forum/showthread.php?36206/page2

;;; Modifications by Steve J:
;;;   14 May 2009 - To use dashed red vector lines 

;;; Wish list 14 Nov 2010:
;;;   To be able to select with wildcard when
;;;   attribute tag RIN ends with PNG.
;;;   Why "*PNG" no workee?


(defun c:ZQA (/ ss attLst Box ul lr)
 (vl-load-com)
 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (progn
     (foreach Obj (mapcar 'vlax-ename->vla-object
                    (mapcar 'cadr (ssnamex ss)))
       (setq attLst nil)
       (foreach att (vlax-safearray->list
                      (vlax-variant-value
                        (vla-getAttributes Obj)))
         (setq attLst (cons (cons (vla-get-TagString att)
                                  (vla-get-TextString att)) attLst)))
[color=red]       (if (and (assoc "RIN" attLst)
                (eq "*PNG" (cdr (assoc "RIN" attLst)))[/color]
                (setq Box (assoc "BOXSIZE" attLst)
                      Box (read (cdr Box))))
         (progn
           (setq ul (list (car Box) (cadr Box))
                 lr (list (caddr Box) (cadddr Box)))
           (grvecs (list -1 lr (list (car lr) (cadr ul))
                         -1 ul (list (car lr) (cadr ul))
                         -1 lr (list (car ul) (cadr lr))
                         -1 ul (list (car ul) (cadr lr))))))))
   (princ "\n<!> No Attributed Blocks Found <!>"))
 (princ)
 )

[Lee Mac]

Quick fix,

 

(wcmatch (cdr (assoc "RIN" attlst)) "*PNG")

 

But I need to properly look over the code a bit more... its been a while

[Lee Mac]

Hi Steve,

 

I've had a quick look over the code and perhaps this might be a better solution:

 

;;;
;;; Crafted by Lee Mac at cadtutor.net 14 May 2009
;;; http://www.cadtutor.net/forum/showthread.php?36206/page2

;;; Modifications by Steve J:
;;;   14 May 2009 - To use dashed red vector lines 

;;; Wish list 14 Nov 2010:
;;;   To be able to select with wildcard when
;;;   attribute tag RIN ends with PNG.
;;;   Why "*PNG" no workee?

;;; Rewritten by Lee Mac 16.11.10, untested though!

(defun c:zqa ( / ss )

 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (
     (lambda ( i / e el lst box ul lr )
       (while (setq e (ssname ss (setq i (1+ i)))) (setq lst nil)

         (while
           (not
             (eq "SEQEND"
               (cdr
                 (assoc 0
                   (setq el
                     (entget
                       (setq e (entnext e))
                     )
                   )
                 )
               )
             )
           )
           (setq lst
             (cons
               (cons
                 (strcase
                   (cdr
                     (assoc 2 el)
                   )
                 )
                 (cdr (assoc 1 el))
               )
               lst
             )
           )
         )

         (if
           (and
             (assoc "RIN" lst)
             (wcmatch (strcase (cdr (assoc "RIN" lst))) "*PNG")
             (setq box (cdr (assoc "BOXSIZE" lst)))
             (setq box (read box))
           )
           (progn
             (setq ul (list (car   box) (cadr   box))
                   lr (list (caddr box) (cadddr box))
             )
             
             (grvecs
               (list -1 lr (list (car lr) (cadr ul))
                     -1 ul (list (car lr) (cadr ul))
                     -1 lr (list (car ul) (cadr lr))
                     -1 ul (list (car ul) (cadr lr))
               )
             )
           )
         )
       )
     )
     -1
   )
 )

 (princ)
)

Untested however...

Edited November 16, 2010 by Lee Mac

[StevJ]

Wow. You're pretty quick with this.

I tried the suggestion in your first response, and it worked just fine, Lee, but the second post gave a 'too many arguments' error. But it looks so neat, i'm trying to figure it out.

 

Steve

[Lee Mac]

Wow. You're pretty quick with this.

I tried the suggestion in your first response, and it worked just fine, Lee, but the second post gave a 'too many arguments' error. But it looks so neat, i'm trying to figure it out.

 

Thanks

 

I'll check it mate - that's the problem with not testing it...

 

Missed a 'cons'... hopefully fixed - Code updated

[StevJ]

Sorry for the delayed response - the forum kept logging me out.

 

It works perfectly, Lee. Impressive.

Thanks again for your help

 

Steve

Edited November 16, 2010 by StevJ
Keyboard can't spell

[Lee Mac]

Excellent Steve, good to hear