Print coordinates

[cabltv1]

Please help!

I have a blocked named "RF_SLACK". It has 3 TAGs/Attributes that are required to be filled out. The 3 TAGs are below.

PT1

PT2

COORD

 

What I need is some way to check and make sure the 3 TAG/Attributes have been filled out.

 

I have some thoughts on how this should be acomplished.

1) If the "RF_SLACK" block does not have the 3 Attributes filled out, zoom to that block and stop code.

2) A report in the Command Window that includes the Handle of the block without all 3 Attributes filled out. I do not know to go to a block handle so I will need some code to find and zoom to that block.

 

I realy would appreciate any help I can get here!

Thanks.

[uddfl]

I am not sure I perfectly understand your question, especially the Block Hande part, but based on your post I assume you do know how to write some LISP.

 

Since you know what the block geometry looks like, maybe you can tell the routine to zoom in to specific coordinates that relate to the block's insertion point (polar comes to mind)?

 

As for finding the block instances that do not have the attributes filled out, you would use (if) or (cond) to see if (= (cdr (assoc 2 elist)) ""). But you probably know that part. If you already have some code written, post it, and maybe you can get better help.

[cabltv1]

I appreciate your suggestions but even though I do know some LISP, I do not enough to pull this off on my own.

 

Still need help!

[ASMI]

Some like:

 

(defun c:stopzoom(/ bSet lPt tPt)
 (vl-load-com)
 (if(setq bSet(ssget "_X" '((0 . "INSERT")(2 . "RF_SLACK")(66 . 1))))
   (foreach b (mapcar 'vlax-ename->vla-object 
                (vl-remove-if 'listp(mapcar 'cadr(ssnamex bSet))))
     (foreach a(vlax-safearray->list(vlax-variant-value(vla-GetAttributes b)))
(if(= ""(vla-get-TextString a))
  (progn
    (vla-GetBoundingBox b 'lPt 'tPt) 
     (vla-ZoomWindow(vlax-get-acad-object)lPt tPt)
     (princ(strcat "\nInvalid block handle = " (vla-get-Handle b)))
     (getkword "\nPress Enter to continue... ")
    ); end progn
  ); end if
); end foreach
     ); end foreach
   ); end if
 (princ)
 ); end of c:stopzoom

 

But you need to learn write own code.

[uddfl]

ASMI, you are a vlisp machine.

[cabltv1]

ASMI,

The program does a great job of finding each block ("RF_SLACK") and zooming in on it. The problem is that each drawing could contain 100+ of these blocks and I don't wont to edit each block to make sure all 3 attributes have something filled in.

I tested the code and it does zoom to each block but what I am needing is for it to zoom to each RF_SLACK block that has any empty attribute for the following TAGs: (In other words, if any of the 3 TAGs is emtpty, I need it to zoom to the block in question. If all 3 attributes have some information, I need the code to skip the block and move on.)

PT1

PT2

COORD

 

If the above TAGs contain any information at all, I need the routine to skip past it.

 

Thanks for any help!

[Lee Mac]

Hmmm... that is weird, because ASMI's code clearly specifies using an IF function that the code will only zoom in when the attribute value is "" (i.e. an empty string...

[Lee Mac]

This may be a quick fix:

 

(defun c:chkatt (/ ss na eLst att attLst pt1val pt2val coval nulblk)
 (vl-load-com)
 (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 "RF_SLACK") (cons 66 1)
   (if (getvar "CTAB") (cons 410 (getvar "CTAB"))(cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq na (ssadd)
       eLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e eLst
   (setq att (entnext e))
   (while (= "ATTRIB" (cdr (assoc 0 (setq attLst (entget att)))))
     (cond ((= "PT1" (cdr (assoc 2 attLst)))
        (setq pt1val (cdr (assoc 1 attLst))))
       ((= "PT2" (cdr (assoc 2 attLst)))
        (setq pt2val (cdr (assoc 1 attLst))))
       ((= "COORD" (cdr (assoc 2 attLst)))
        (setq coval (cdr (assoc 1 attLst)))))
     (setq att (entnext att)))
   (if (or (eq "" pt1val) (eq "" pt2val) (eq "" coval))
       (ssadd e na))
   (setq pt1val nil pt2val nil coval nil))
     (setq nulblk (rtos (sslength na) 2 0))
     (alert (strcat nulblk " Blocks With Null Attributes. "))
     (sssetfirst nil na))
   (princ "\n<!> No Blocks Found <!>"))
 (princ))

[cabltv1]

Lee,

You are amazing. You must spend all of your time on this site.

Your answer works great. It doesn't zoom to the block but it selects all blocks missing information. This may work better than zooming to the block for the fix and then moving to the next one.

ASMI,

Thanks very much for your contribution.

[cabltv1]

I know I am pushing it here but is there a way to modify this code to just check the TAG: COORD ?

[ASMI]

I know I am pushing it here but is there a way to modify this code to just check the TAG: COORD ?

 

Modify tLst variable to add or remove tags:

 

(defun c:stopzoom(/ bSet lPt tPt tLst fErr)

 (setq tLst(list "COORD")) ; modify tag list
      
 (vl-load-com)
 
 (if(setq bSet(ssget "_X" '((0 . "INSERT")(2 . "RF_SLACK")(66 . 1))))
   (progn
    (foreach b (mapcar 'vlax-ename->vla-object 
                (vl-remove-if 'listp(mapcar 'cadr(ssnamex bSet))))
     (foreach a(vlax-safearray->list(vlax-variant-value(vla-GetAttributes b)))
(if(and
      (member(vla-get-TagString a)tLst)
      (= ""(vla-get-TextString a))
     ); end and
  (progn
    (vla-GetBoundingBox b 'lPt 'tPt) 
     (vla-ZoomWindow(vlax-get-acad-object)lPt tPt)
     (setq fErr T)
     (princ(strcat "\nInvalid block handle = " (vla-get-Handle b)))
     (getkword "\nPress Enter to continue... ")
    ); end progn
  ); end if
); end foreach
     ); end foreach
    (if(not fErr)(princ "\nNo empty attributes found. "))
    ); end progn
   (princ "\nNo blocks found! ")
   ); end if
 (princ)
 ); end of c:stopzoom

 

Soon it is necessary to you will learn to write own code or to employ the programmer

[cabltv1]

I think I finished the program I have been working on for the last month.

Thanks much to all that helped!!!

[Lee Mac]

Lee,

You are amazing. You must spend all of your time on this site.

Your answer works great. It doesn't zoom to the block but it selects all blocks missing information. This may work better than zooming to the block for the fix and then moving to the next one.

 

Thank you for your kind words cabltv - I do get a bit of practice from this site

 

Glad you got your program sorted

 

 

Cheers

 

Lee

[Lee Mac]

Updated for just the COORD tag:

 

(defun c:chkatt (/ ss na eLst att attLst coval nulblk)
 (vl-load-com)
 (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 "RF_SLACK") (cons 66 1)
   (if (getvar "CTAB") (cons 410 (getvar "CTAB"))(cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq na (ssadd)
       eLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e eLst
   (setq att (entnext e))
   (while (= "ATTRIB" (cdr (assoc 0 (setq attLst (entget att)))))
     (if(= "COORD" (cdr (assoc 2 attLst)))
        (setq coval (cdr (assoc 1 attLst))))
     (setq att (entnext att)))
   (if (eq "" coval)
       (ssadd e na))
   (setq coval nil))
     (setq nulblk (rtos (sslength na) 2 0))
     (alert (strcat nulblk " Blocks With Null Attributes. "))
     (sssetfirst nil na))
   (princ "\n<!> No Blocks Found <!>"))
 (princ))

 

Although, tbh, credit should go to ASMI's solution as it uses more advanced and better coding ~ nice one ASMI

[uddfl]

I know I am pushing it here but is there a way to modify this code to just check the TAG: COORD ?

Why don't you 'saveas' the code you've been given and have a bash at modifying it? If you fail, come back, but at least you can try and learn something.

[Lee Mac]

Why don't you 'saveas' the code you've been given and have a bash at modifying it? If you fail, come back, but at least you can try and learn something.

 

I must admit, uddfl does have a point, as the code does show a pattern and one can clearly see where and how the attributes are being retrieved just from looking at the Tag Names in the code.