Multiple Attribute/Dynamic Property Filter?

Here's the issue: I extract a large number of blocks (400+) to a table. There are large counts of some blocks, where the queried attributes/properties are identical in value. But inevitably, in placing each block individually, I screw up one property value, so it's gets it's own entry in the table.

For example, I have "piecemark" (attribute), with a value of "ABC", and a "length" (dynamic property) of " 4' ". There are 42 blocks with those values. But on one, I accidentally set the dynamic property to 5'. Now I have to go through all 43 blocks and find the erroneous one.

The BEST solution would be if you could edit the table, and have it write back to the block! That's way beyond my rudimentary lisp/VB skills. (If anyone else wants to write such a routine, I'd be happy to pay for it)!

Another good one would be if you could somehow select (an) object(s) by clicking a context menu item from a table record ("Select Parent Block" or something).

My attempted solution was to set an attribute "length_att" to the value of the parameter (length) via a field, so I could at least use a couple iterations of FIND/SELECT ALL to isolate the offending block. However, adding attributes and fields to a block late in the game seems to confuse AutoCAD (which shows a duplicate attribute def). SYNC via BATTMAN doesn't help - as well as taking literally 10 minutes to finish.

I'm weary of editing my blocks at all at this point, because it takes a very long time to save the block back (5 to 10 minutes), and 50% of the time the modification "doesn't have the intended effect."

So if anyone has any insights on how else I might filter with multiple attribute/property values...

are all your piecemark ABC blocks 4' or do you have x @ length?

Hi Dave,

Every length has a unique piece mark.

What happens when I goof up is:

Mark, Length, Count

--------------------

abc1, 4', 20

abc2, 6'-5/8", 34

abc2, 4'-9", 1

abc3, 2'-3/16", 30

--------------------

In that case, I'd like to have functionality like select block where piecemark = abc2 and length = 4'-9".

I was hoping to suggest using QSELECT twice, the first time to get all Block References with Name = XXXX and the working on the previous selection set get all where Length = yyy, but I've just tried it and it doesn't work.

Once you have found your piece you can change the value using the properties palette.

I'll have a further think but don't hold your breath waiting for me.

That's basically how I was trying to use the FIND command. For some odd reason, FIND has options for embedded attributes and dimension text, but not embedded dimension text or parameter text!

Sigh.

The work-around is to create a field referencing a dimension, and set that dimension to stretch with the length of the block as the grips are modified.

The problem with THAT is - with this huge set of blocks, updating them is now pushing a literal 20 minutes, on top of re-sync'ing, which is also taking about 20 minutes. And when it finally finishes, there are errors. Works just fine in a small drawing.

Maybe it's time I actually learn lisp. I imagine it would take just a couple of lines to scan through a selection set looking for blocks with attribute values matching the search values.

I'd still dream about a block-to-record hyperlink of some sort though.

> verso

I have tried to make the small sketch of the code necessary to you. It seem works but may have some bugs. Your blocks must have dynamic parameter with a name 'length' and at least one attribute.

(defun c:dycount(/ sBlk eBlk dyPrp cProp curBl prLst
        cSt efNm fLst bSet nSet outLst rpLst)
 
 (vl-load-com)
 
 (if
    (setq sBlk(entsel "\nSelect sample block > "))
   (if
     (and
(= "INSERT"(cdr(assoc 0(entget(setq eBlk(car sBlk))))))
(setq sBlk(vlax-ename->vla-object(car sBlk)))
(= :vlax-true(vla-get-IsDynamicBlock sBlk))
(setq dyPrp(vlax-safearray->list
	     (vlax-variant-value
		(vla-GetDynamicBlockProperties sBlk))))
); end and
     (progn
 (foreach itm dyPrp
   (if(= "LENGTH"(strcase(vla-get-PropertyName itm)))
     (setq cSt T)
   ); end if
 ); end foreach
    (if cSt
      (progn
	(setq efNm(vla-get-EffectiveName sBlk))
	(if(setq bSet(ssget "_X" '((0 . "INSERT"))))
	  (progn
	    (setq bSet(vl-remove-if 'listp
				(mapcar 'cadr(ssnamex bSet)))
		  nSet(ssadd))
	    (foreach i bSet
	      (setq curBl(vlax-ename->vla-object i))
	      (if
		(and
		  (vlax-method-applicable-p
		    curBl 'GetDynamicBlockProperties)
		  (= efNm(vla-get-EffectiveName curBl))
		  ); end and
		(ssadd i nSet)
		); end if
	      ); end foreach
	    (setq nSet(mapcar 'vlax-ename->vla-object
			      (vl-remove-if 'listp
				(mapcar 'cadr(ssnamex nSet)))))
	    (foreach bl nSet
	      (setq prLst(vlax-safearray->list
		            (vlax-variant-value
			      (vla-GetDynamicBlockProperties bl))))
	      (foreach pr prLst
		(if(= "LENGTH"(strcase(vla-get-PropertyName pr)))
		  (progn
		    (setq outLst(cons
				  (list
				    (vla-get-TextString
				    (car(vlax-safearray->list
				      (vlax-variant-value
					(vla-GetAttributes bl)))))
				    (vlax-variant-value
				       (vla-get-Value pr))
				    ); end list
				  outLst
				  ); end cons
			  ); end setq
		   ); end progn
		  ); end if
		); end foreach
	      ); end foreach
	    (setq lLen(length outLst))
                   (while outLst
                     (setq rpLst(cons(append(car outLst)
                      (list(- lLen(setq lLen(length (setq outLst
                (vl-remove(car outLst)outLst)))))))rpLst)
                      ); end setq
                     ); end while
	    (setq rpLst(vl-sort rpLst
			  '(lambda(a b)(<(car a)(car b)))))
	    (princ "\n\n Mark      Length          Count")
	    (princ "\n -------------------------------")
	    (foreach str rpLst
	        (princ(strcat "\n " (car str)" "))
	        (repeat(- 8(strlen(car str)))(princ "."))
	        (princ(strcat " " (rtos(cadr str)) " "))
	        (repeat(- 8(strlen(rtos(last str))))(princ "."))
	        (princ(strcat " "(itoa(last str))))
	      ); end foreach
	    (princ "\n -------------------------------")
	    (textscr)
	    ); end progn
	  (princ "\n>>> Nothing selected! <<< ")
	  ); end if
	); end progn
      (princ "\n>>> 'Length' parameter not found! <<< ")
      ); end if
    ); end progn
           (princ "\n>>> It isn't Dynamic Block! <<< ")
  ); end if
   (princ "\n>>> Nothing selected! <<< ")
  ); end if
 (princ)
 ); end of c:dycount

Tests (parameter 'length' - metric):

Command: dycount

Select sample block >

Mark      Length          Count
-------------------------------
abc1 .... 8371.9946 ....... 9
abc2 .... 5902.6785 ....... 7
abc2 .... 3901.6785 ....... 1
abc3 .... 2951.3392 ....... 4
-------------------------------

> I have tried to make the small sketch of the code necessary to you.

First of all - wow. That was far more than I was expecting. Thank you so much for taking the time!

I can't quite get it to work though. My output is always:

DYCOUNT
Select sample block > T
Mark      Length          Count
-------------------------------
-------------------------------

The T is from a debug princ I left in.

I emailed an actual block and modified routine (changed "length" to "nominal length". But please don't feel obligated. I only ask because you'll probably find the problem in 2 minutes, as opposed to my 200 minutes. :wink:

Ok, this should works with your block:

(defun c:dycount(/ sBlk eBlk dyPrp cProp curBl prLst
        cSt efNm fLst bSet nSet outLst rpLst
	attAr cAtt)

 (vl-load-com)
 
 (if
    (setq sBlk(entsel "\nSelect sample block > "))
   (if
     (and
(= "INSERT"(cdr(assoc 0(entget(setq eBlk(car sBlk))))))
(setq sBlk(vlax-ename->vla-object(car sBlk)))
(= :vlax-true(vla-get-IsDynamicBlock sBlk))
(setq dyPrp(vlax-safearray->list
	     (vlax-variant-value
		(vla-GetDynamicBlockProperties sBlk))))
); end and
     (progn

 (foreach itm dyPrp
    ;(princ "\n")
    ;(princ (vla-get-PropertyName itm))
   (if(= "NOMINAL LENGTH"(strcase(vla-get-PropertyName itm)))
     (setq cSt T)
   ); end if
 ); end foreach
    (if cSt
      (progn
	(setq efNm(vla-get-EffectiveName sBlk))
	(if(setq bSet(ssget "_X" '((0 . "INSERT"))))
	  (progn
	    (setq bSet(vl-remove-if 'listp
				(mapcar 'cadr(ssnamex bSet)))
		  nSet(ssadd))
	    (foreach i bSet
	      (setq curBl(vlax-ename->vla-object i))
	      (if
		(and
		  (vlax-method-applicable-p
		    curBl 'GetDynamicBlockProperties)
		  (= efNm(vla-get-EffectiveName curBl))
		  ); end and
		(ssadd i nSet)
		); end if
	      ); end foreach
	    (setq nSet(mapcar 'vlax-ename->vla-object
			      (vl-remove-if 'listp
				(mapcar 'cadr(ssnamex nSet)))))
	    (foreach bl nSet
	      (setq prLst(vlax-safearray->list
		            (vlax-variant-value
			      (vla-GetDynamicBlockProperties bl)))
		    attAr(vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetAttributes bl)))
		    ); end setq
	      (foreach at attAr
		(if(= "PIECEMARK"(vla-get-TagString at))
		  (setq cAtt at)
		  ); end if
		); end foreach
	      (foreach pr prLst
		(if(= "NOMINAL LENGTH"(strcase(vla-get-PropertyName pr)))
		  (progn
		    (setq outLst(cons
				  (list
				    (vla-get-TextString cAtt)
				    (vlax-variant-value(vla-get-Value pr))
				    ); end list
				  outLst
				  ); end cons
			  ); end setq
		   ); end progn
		  ); end if
		); end foreach
	      ); end foreach
	    (setq lLen(length outLst))
                   (while outLst
                     (setq rpLst(cons(append(car outLst)
                      (list(- lLen(setq lLen(length (setq outLst
                (vl-remove(car outLst)outLst)))))))rpLst)
                      ); end setq
                     ); end while
	    (setq rpLst(vl-sort rpLst
			  '(lambda(a b)(<(car a)(car b)))))
	    (princ "\n\n Mark             Length           Count")
	    (princ "\n ---------------------------------------")
	    (foreach str rpLst
	        (princ(strcat "\n " (car str) " "))
	        (repeat(- 15(strlen(car str)))(princ "."))
	        (princ(strcat " "(rtos(cadr str))" "))
	        (repeat(- 15(strlen(rtos(cadr str))))(princ "."))
	        (princ(strcat " "(itoa(last str))))
	      ); end foreach
	    (princ "\n ---------------------------------------")
	    (textscr)
	    ); end progn
	  (princ "\n>>> Nothing selected! <<< ")
	  ); end if
	); end progn
      (princ "\n>>> 'Nominal Length' parameter not found! <<< ")
      ); end if
    ); end progn
           (princ "\n>>> It isn't Dynamic Block! <<< ")
  ); end if
   (princ "\n>>> Nothing selected! <<< ")
  ); end if
 (princ)
 ); end of c:dycount

Test:

 Select sample block >

Mark             Length           Count
---------------------------------------
XXMK-01 ........ 5'-1" .......... 1
XXMK-01 ........ 6' ............. 5
XXMK-02 ........ 9'-7 1/2" ...... 9
---------------------------------------

Works great!

I'm trying to hack it a bit to add a lookup function. Basically just another column with an ID. After listing the table, it would prompt for an ID, then add blocks from that record to the selection set.

Needless to say, hacking code with only a superficial understanding of the language is probably the most inefficient process known to mankind.

I added this loop after the final list of blocks has been sorted:

      (setq lookUpID 0)
     (foreach str rpLst
       (setq str (append str '(lookUpID)))
       (setq lookUpID (+ lookUpID 1))
     ); end foreach

But it doesn't seem to actually be appending the lookUpID to the list. Maybe foreach assigns a copy of the element to str, rather than a reference...? which would explain why you had to write...

 
(setq rpLst(cons(append(car outLst)
(list(- lLen(setq lLen(length (setq outLst
 (vl-remove(car outLst)outLst)))))))rpLst)
); end setq

... which has given me a headache.

I think maybe I need to take a Saturday or 5 to learn lisp.

I haven't even thought about the part where the ID is tied to the objects... it'd probably be easiest to just scan the original set of blocks again (nSet?) looking for a property/attribute match. Or maybe just the object's db ID to rpLst...

Closer and closer!

dylookup.lsp

I see that at you good abilities to code debugging, however I have already improved the program.

I think that the new version will meet basic your wishes. Probable errors are marked now by an asterisk and you can find them having typed them ID. The program will higlight them and make a zoom. New routine name is ERRFIND because it response of it function.

(defun c:errfind(/ sBlk eBlk dyPrp cProp curBl prLst
        cSt efNm fLst bSet nSet outLst rpLst
	attAr cAtt luID oLst cPmk sPmk cLen
	sLen fCnt eFlg erFlg lLen iAtt cId
	eSet)

 (vl-load-com)
 
 (if
    (setq sBlk(entsel "\nSelect sample block > "))
   (if
     (and
(= "INSERT"(cdr(assoc 0(entget(setq eBlk(car sBlk))))))
(setq sBlk(vlax-ename->vla-object(car sBlk)))
(= :vlax-true(vla-get-IsDynamicBlock sBlk))
(setq dyPrp(vlax-safearray->list
	     (vlax-variant-value
		(vla-GetDynamicBlockProperties sBlk))))
); end and
     (if(= :vlax-true(vla-get-HasAttributes sBlk))
(progn
 (foreach a(vlax-safearray->list
	    (vlax-variant-value
	      (vla-GetAttributes sBlk)))
  (if(= "PIECEMARK"(vla-get-TagString a))
     (setq iAtt T)
    ); end if
   ); end foreach
      (if iAtt
 (progn
 (foreach itm dyPrp
   (if(= "NOMINAL LENGTH"(strcase(vla-get-PropertyName itm)))
     (setq cSt T)
   ); end if
 ); end foreach
    (if cSt
      (progn
	(setq efNm(vla-get-EffectiveName sBlk))
	(if(setq bSet(ssget "_X" '((0 . "INSERT"))))
	  (progn
	    (setq bSet(vl-remove-if 'listp
				(mapcar 'cadr(ssnamex bSet)))
		  nSet(ssadd))
	    (foreach i bSet
	      (setq curBl(vlax-ename->vla-object i))
	      (if
		(and
		  (vlax-method-applicable-p
		    curBl 'GetDynamicBlockProperties)
		  (= efNm(vla-get-EffectiveName curBl))
		  ); end and
		(ssadd i nSet)
		); end if
	      ); end foreach
	    (setq nSet(mapcar 'vlax-ename->vla-object
			      (vl-remove-if 'listp
				(mapcar 'cadr(ssnamex nSet)))))
	    (foreach bl nSet
	      (setq prLst(vlax-safearray->list
		            (vlax-variant-value
			      (vla-GetDynamicBlockProperties bl)))
		    attAr(vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetAttributes bl)))
		    ); end setq
	      (foreach at attAr
		(if(= "PIECEMARK"(vla-get-TagString at))
		  (setq cAtt at)
		  ); end if
		); end foreach
	      (foreach pr prLst
		(if(= "NOMINAL LENGTH"(strcase(vla-get-PropertyName pr)))
		  (progn
		    (setq outLst(cons
				  (list
				    (vla-get-TextString cAtt)
				    (vlax-variant-value(vla-get-Value pr))
				    ); end list
				  outLst
				  ); end cons
			  ); end setq
		   ); end progn
		  ); end if
		); end foreach
	      ); end foreach
	    (setq lLen(length outLst))
                   (while outLst
                     (setq rpLst(cons(append(car outLst)
                      (list(- lLen(setq lLen(length (setq outLst
                (vl-remove(car outLst)outLst)))))))rpLst)
                      ); end setq
                     ); end while
	    (setq rpLst(vl-sort rpLst
			  '(lambda(a b)(<(car a)(car b))))
		  luId 1
		  oLst '()); end setq
	    (foreach i rpLst
	      (if(assoc(car i)(vl-remove i rpLst))
		 (setq oLst(append oLst(list(cons(strcat(itoa luId)"*")i)))
		      erFlg T)
		 (setq oLst(append oLst(list(cons(itoa luId)i))))
		); end if
	      (setq luId(1+ luId))
	      ); end foreach
	    (princ "\n\n ID       Mark             Length           Count")
	    (princ "\n ------------------------------------------------")
	    (foreach str oLst
	        (princ(strcat "\n "(car str) " "))
	        (repeat(- 7(strlen(car str)))(princ "."))
	        (princ(strcat " "(cadr str) " "))
	        (repeat(- 15(strlen(cadr str)))(princ "."))
	        (princ(strcat " "(rtos(nth 2 str))" "))
	        (repeat(- 15(strlen(rtos(nth 2 str))))(princ "."))
	        (princ(strcat " "(itoa(last str))))
	      ); end foreach
	    (princ "\n ------------------------------------------------")
	    (if erFlg
	      (princ "\n * Warning! Error(s) are found!\n")
	      ); end if
	    (textscr)
	    (while(not eFlg)
	    (initget 128)
	    (if(setq cId(getint "\nEnter ID to find pieces or [Quit]: "))
	      (cond
		((and(= 'STR(type cId))(= "Q"(strcase cId)))
		 (princ "\nQuit 'ErrFind'.")
		 (setq eFlg T)
		 ); end condition #1
		((= 'STR(type cId))
		 (princ "\nIvalid keyword option! ")
		 ); end condition #2
		((or(> cId(length oLst))(< cId 1))
		 (princ "\nId out of range! ")
		 ); end condition #3
		(T
		 (setq sPmk(cadr(nth(1- cId)oLst))
		       sLen(nth 2(nth(1- cId)oLst))
		       fCnt 0
		       eFlg T
		       eSet(ssadd)
		       ); end setq
	    (foreach bl nSet
	      (setq prLst(vlax-safearray->list
		            (vlax-variant-value
			      (vla-GetDynamicBlockProperties bl)))
		    attAr(vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetAttributes bl)))
		    ); end setq
	      (foreach at attAr
		(if(= "PIECEMARK"(vla-get-TagString at))
		  (setq cPmk(vla-get-TextString at))
		  ); end if
		); end foreach
	      (foreach pr prLst
		(if(= "NOMINAL LENGTH"(strcase(vla-get-PropertyName pr)))
		  (setq cLen(vlax-variant-value(vla-get-Value pr)))
		  ); end if
		); end foreach
	      (if(and(= sPmk cPmk)(= sLen cLen))
		  (ssadd(vlax-vla-object->ename bl)eSet)
		); end if
	      ); end foreach
	        (graphscr)
		(princ(strcat "\n"(itoa(sslength eSet)) " found."))
		(setvar "CMDECHO" 0)
		(command "_.zoom" "_o" eSet "")
		(setvar "CMDECHO" 1)
		(sssetfirst nil eSet)
		 ); end condition #4
		); end cond
	       ); end if
	      ); end while 
	     ); end progn
	    (princ "\n<!> Nothing selected! <!>")
	   ); end if
	  ); end progn
         (princ "\n<!> 'Nominal Length' parameter not found! <!> ")
        ); end if
       ); end progn
      (princ "\n<!> 'Piecemark' attribute not found! <!> ")
     ); end if
    ); end progn
   (princ "\n<!> This block hasn't attributes <!> ")
  ); end if
         (princ "\n<!> It isn't Dynamic Block! <!> ")
); end if
   (princ "\n<!> Nothing selected! <!>")
  ); end if
 (princ)
 ); end of c:errfind

Test:

Command: errfind

Select sample block >

ID       Mark             Length           Count
------------------------------------------------
1 ...... XXMK-01 ........ 7'-11 5/16" .... 13
2 ...... XXMK-02 ........ 6'-8 7/8" ...... 7
3* ..... XXMK-XX ........ 4'-2 11/16" .... 4
4* ..... XXMK-XX ........ 6' ............. 2
------------------------------------------------
* Warning! Error(s) are found!

Enter ID to find pieces or [Quit]: 3

4 found.

I see that at you good abilities to code debugging, however I have already improved the program.

Now THAT'S what I wanted to hear. :wink:

Seriously - that is quite the chunk of code, and will be immensely useful to me. I hope it didn't take you too long to write it!

It worked perfectly - on 449 blocks, with 74 unique ID's - and found 2 errors.

If I ever need to hire a lisp'er, you're at the top of the list.

Thank you again!

Seriously - that is quite the chunk of code, and will be immensely useful to me. I hope it didn't take you too long to write it!

 

It worked perfectly - on 449 blocks, with 74 unique ID's - and found 2 errors.

Was glad to help you, it has borrowed not too much time, probably hour and a half or two hours on all code. At a forum I write only that code which is interesting to me, it is that case.

Successes with your work.