Jump to content
osho327

Selection of blocks using two attribute values and then sum of third attribute

Recommended Posts

osho327

Hello Everyone,

 

I am a novice in lisp and cannot figure out how to tweak the lisp to get the desired results ,

so i need your help to get this working

I am attaching a dwg file with the blocks that we are dealing with.

Each block has following 8 attributes.

 

STA. (Station /Controller)

SIZE

IM

GPM

PR

PSI

AREA

HYDZ (Hydrozone)

 

We need to select blocks first by "STA." (wild card selection) and then refine the list with second attribute called "HYDZ" then display no of blocks selected and the sum of "AREA" attribute of the selected blocks.

 

I found this lisp on the internet that enables me to select the blocks with one attribute and works with wildcard entry , We need to add second selection criteria to refine the results

 

 

(defun ssattval (val / ss res ref name blk)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
 (setq res (ssadd))
 (if (ssget "_X" '((0 . "INSERT") (66 . 1)))
   (progn
     (vlax-for ref (setq ss (vla-get-ActiveSelectionSet *acdoc*))
       (setq has nil)
       (foreach att (vlax-invoke ref 'GetAttributes)
         (if (wcmatch (strcase (vla-get-TextString att)) (strcase val))
           (setq has T)
         )
       )
       (if has
         (ssadd (vlax-vla-object->ename ref) res)
       )
     )
     (vla-delete ss)
   )
 )
 (if (< 0 (sslength res))
   res
 )
)

(defun c:ssattval (/ val)
 (if (setq val (getstring "\Enter the value of attribute: "))
   (sssetfirst nil (ssattval val))
 )
 (princ)
)

 

 

another code I have that gives me the sum of Area of blocks is

 

(defun c:sfXX(/ ss1 ssl ctr area area_total chk2 g2 e1 d1 g0 g2)
           (setfunc)
           (setq   ss1                              (ssget(list(cons 2 "CA*")))
                       ssl                                (1-(sslength ss1))
                       ctr                               0
                       area                            0.0
                       area_total            0.00
                       lu                                 (getvar "LUNITS")
                                   )
           (setvar  "lunits" 2)
           (while(>= ssl ctr)
                       (setq   e1       (ssname ss1 ctr)
                                   d1       (entget e1)
                                   g0       (cdr(assoc 0 d1))
                                   g1       (cdr(assoc 1 d1))
                                   g2       (cdr(assoc 2 d1))
                                   g3       (cdr(assoc 3 d1))
                                   g4       (cdr(assoc 4 d1))
                                   g5       (cdr(assoc 5 d1))
                                   g6       (cdr(assoc 6 d1))
                                   g7       (cdr(assoc 7 d1))
                                              
                                               )

                       (if (/= g2 nil)
                                   (setq chk2 (substr g2 1 2) )
                       )
                       (if (= g0 "INSERT")
                                   (if (= chk2 "CA")
                                               (while (/= g2 "AREA")
                                                           (setq   g2       nil
                                                                                   e1       (entnext e1)
                                                                                   d1       (entget e1)
                                                                                   g0       (cdr(assoc 0 d1))
                                                                                   g1       (cdr(assoc 1 d1))
                                                                                   g2       (cdr(assoc 2 d1))
                                                                                   g3       (cdr(assoc 3 d1))
                                                                                   g4       (cdr(assoc 4 d1))
                                                                                   g5       (cdr(assoc 5 d1))
                                                                                   g6       (cdr(assoc 6 d1))
                                                                                   g7       (cdr(assoc 7 d1))
                                                                                  

                                                                                   )

                                                           (if (= g2 "AREA")
                                                                       (setq   area                (atof (n2 g1))
                                                                                   area_total    (+ area_total area)
                                                                                               )
                                                           )
                                               )
                                   )
                       )
                       (setq ctr(1+ ctr))
           )

(princ(strcat "\nThe total Area = "(rtos area_total)" Square Feet"))


           area_total 0.0
           (setvar "LUNITS" lu)
           (resetfunc)
           (princ)
)

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

(defun n2 (str / a b)
 (repeat (strlen str)
   (if    (< 47 (ascii (setq b (substr str 1 1))) 58)
     (setq a (cons b a))
   )
   (setq str (substr str 2))
 )
 (apply 'strcat (reverse a))
)

 

There is another code by lee mac for selection of blocks by attributes this also takes wild card entries if this one is easier to modify to filter the selection by second attribute

 


;; Select Blocks by Attribute Value - Lee Mac

;; Selects all attributed blocks in the current layout which contain a specified attribute value.

(defun c:sel2 ( / att atx ent idx sel str )
(if (/= "" (setq str (strcase (getstring t "\nSpecify attribute value: "))))

(if (and
(setq sel
(ssget "_X"
(list '(0 . "INSERT") '(66 . 1) '(2 . "CA*")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab)) 
'(410 . "Model")

)
)
)
)
(progn
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
att (entnext ent)
atx (entget att)
)
(while
(and (= "ATTRIB" (cdr (assoc 0 atx)))
(not (wcmatch (strcase (cdr (assoc 1 atx))) str))
)
(setq att (entnext att)
atx (entget att)
)
)
(if (= "SEQEND" (cdr (assoc 0 atx)))
(ssdel ent sel)
)
)
(< 0 (sslength sel))
)
)
(sssetfirst nil sel)
(princ (strcat "\nNo blocks found with attribute value matching \"" str "\"."))
)
)
(princ)
)

 

Thanks in advance

new block.dwg

Share this post


Link to post
Share on other sites
BIGAL

Just an idea when you do getattributes make a list of the text strings, this list will be in a certain order always so the STA may be the 1st and the Area last, using (nth last lst)+total area etc Then check the items in the list, this is an example

 

(setq ref (vlax-ename->vla-object (car (entsel "\nPick block"))))
(setq lst '())
(foreach att (vlax-invoke ref 'GetAttributes)
(setq lst (cons (strcase (vla-get-TextString att)) lst))
)

 

result pick a block ("A1" "HOME" "MELWAY" "DRAWING1.DWG" "ARBITRARY" "ARBITRARY" "786" "456" "123" "ME" "9" "8" "7" "6" "5" "4" "3" "2" "1" "PRELIMINARY DRAWING")

Share this post


Link to post
Share on other sites
pBe

Saw the same question on another forum,

 

I pointed out that the first posted routine searches for a string Value regardless of the the attribute TAG name or block name.

 

The sfXX function searches for a block name that starts with CA* and searches for TAG name AREA.

 

I am not clear as to what the final result will be based on? i

Is it add all AREA valid string value of a block with "HYDZ" value of the same name?

or add all AREA valid string value of a block with "HYDZ" value of the same name and the same "STA." value?

or add all AREA valid string value of a block with "STA." and "HYDZ" tag then make a breakdown based on their value?

 

What are the "selection criteria" ?

Share this post


Link to post
Share on other sites
osho327

Thank you for your response pBe

 

The selection criteria is

Firstly by blockname ie CA*

Secondly by STA. by wildcard ( e.g. A*)

Thirdly by HDYZ

 

Then final result is no of blocks selected and sum of AREA attribute of the selected blocks

 

Thank you so much for your help

Share this post


Link to post
Share on other sites
osho327

Thank you so much will look into your code

Share this post


Link to post
Share on other sites
pBe
Thank you for your response pBe

 

The selection criteria is...

 

 

Hello Osho327,

 

Your reply does not tell us anything, Yes it is a block name with "CA*" wildcard, Yes its Value of "STA," tag (Wildcard as well), and Yes "HDYZ" as another criteria. we kinda figured that out from the OP.

 

BUT what is the criteria? say "STA." is "A1" to "A4", then what do we need to consider for "HDYZ"?

 

Give this a whirl

 

(defun c:Starea (/ sta hdz ss i e data fss alldata bLkname)
;; 	  pBe 2017	;;;
 
;;;   From your post	;;;
     
(defun n2 (str / a b)
 (repeat (strlen str)
   (if    (< 47 (ascii (setq b (substr str 1 1))) 58)
     (setq a (cons b a))
   )
   (setq str (substr str 2))
 )
 (apply 'strcat (reverse a))
)
     
;-----------------------;;;

;; 	  pBe 2017	;;;
 
(if (and (setq sta (strcase (getstring "\nEnter the STATION NUMBER value: ")))
	 (not (eq "" sta))
	 (setq hdz (strcase (getstring "\nEnter the HYDROZONE value: ")))
	 (not (eq "" hdz))
         (setq fss (ssadd) ss (ssget "X" '((0 . "INSERT")(66 . 1)(2 . "CA*"))))
	     )
	 (progn
	   (repeat (setq i (sslength ss))
		  	(setq e (ssname ss (setq i (1- i))))
		  	(setq data (mapcar '(lambda (x)
					      (list (vla-get-tagstring x)(vla-get-textstring x)))
					   	(Vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)))
		  	(and 	 (wcmatch (cadr  (assoc "STA." data)) sta)
				 (eq (strcase (cadr  (assoc "HYDZ" data))) hdz)
			         (setq n (distof (n2 (cadr  (assoc "AREA" data)))));<--- m2 from your posted code
				 (ssadd e fss)
			  	 (setq alldata (cons (subst (list "AREA" n)
                                                                  (assoc "AREA" data) data)alldata))
                        		)
                        )
  		(sssetfirst nil fss)
	   )
  	)
 	(princ	
  (cond
	( (eq "" sta) 		"\nInvalid STATION NUMBER"	)
	( (eq "" hdz) 		"\nInvalid HYDROZONE value"		)
  	( (null ss)   		"\nNull selection"		)
	( (null alldata)	"\nCriteria not found"		)
	( T
                      (strcat "\nAREA FOR STATION \"" sta "\" AND HYDROZONE \"" hdz "\" IS \""
		(rtos (apply '+ (mapcar '(lambda (m) (cadr (assoc "AREA" m))) alldata)) 2 2)
			"\" SQUARE FEET AND NO. OF BLOCKS SELECTED ARE \"" (itoa (length alldata)) "\""))
	)
  )
 	(princ)
     )

 

Command: STAREA

Enter the STATION NUMBER value: a*

Enter the HYDROZONE value: hz*

The total Area = 628'-6" Square Feet for 6 Blocks that meets the criteria

 

HTH

Edited by pBe
Updated as per OPs request

Share this post


Link to post
Share on other sites
osho327

Thanks a ton pBe

 

I am sorry I could not make myself clear but this is exactly what i was looking for,you are a genius man.

The code works like a charm and this will save me a lot of time

 

Thank you once again for your efforts

Regards

Share this post


Link to post
Share on other sites
pBe
Thanks a ton pBe

..

Regards

 

You are welcome. I'm glad I was able to help :)

Share this post


Link to post
Share on other sites
osho327

pBe

 

Thank you once again for the code you wrote, it saved me lot of time.

 

The code works great and displays the total no of blocks selected and total area when the AREA field in the blocks have numeric value.

There are certain unique hydrozones when AREA field of ALL its blocks will have "N/A" value ie non numeric

eg

 

All HZ1 blocks will have numeric values in the area field

all HZ3 blocks will have numeric values in the area field

all HZ5 will have "N/A" in the area field

 

its for such cases when the area field is non numeric the code says "criteria not found"

can we modify the code a bit to show the count ie no of blocks selected and total area as "N/A" when it encounters certain unique hydrozones where area field is non numeric.

 

(defun c:Starea (/ sta hdz ss i e data fss alldata bLkname)
;; 	  pBe 2017	;;;
 
;;;   From your post	;;;
     
(defun n2 (str / a b)
 (repeat (strlen str)
   (if    (< 47 (ascii (setq b (substr str 1 1))) 58)
     (setq a (cons b a))
   )
   (setq str (substr str 2))
 )
 (apply 'strcat (reverse a))
)
     
;-----------------------;;;

;; 	  pBe 2017	;;;
 
(if (and (setq sta (strcase (getstring "\nEnter the STATION NUMBER value: ")))
	 (not (eq "" sta))
	 (setq hdz (strcase (getstring "\nEnter the HYDROZONE value: ")))
	 (not (eq "" hdz))
         (setq fss (ssadd) ss (ssget "X" '((0 . "INSERT")(66 . 1)(2 . "CA*"))))
	     )
	 (progn
	   (repeat (setq i (sslength ss))
		  	(setq e (ssname ss (setq i (1- i))))
		  	(setq data (mapcar '(lambda (x)
					      (list (vla-get-tagstring x)(vla-get-textstring x)))
					   	(Vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)))
		  	(and 	 (wcmatch (cadr  (assoc "STA." data)) sta)
				 (eq (strcase (cadr  (assoc "HYDZ" data))) hdz)
			         (setq n (distof (n2 (cadr  (assoc "AREA" data)))));<--- m2 from your posted code
				 (ssadd e fss)
			  	 (setq alldata (cons (subst (list "AREA" n)
                                                                  (assoc "AREA" data) data)alldata))
                        		)
                        )
  		(sssetfirst nil fss)
	   )
  	)
 	(princ	
  (cond
	( (eq "" sta) 		"\nInvalid STATION NUMBER"	)
	( (eq "" hdz) 		"\nInvalid HYDROZONE value"		)
  	( (null ss)   		"\nNull selection"		)
	( (null alldata)	"\nCriteria not found"		)
	( T
                      (strcat "\nAREA FOR STATION \"" sta "\" AND HYDROZONE \"" hdz "\" IS \""
		(rtos (apply '+ (mapcar '(lambda (m) (cadr (assoc "AREA" m))) alldata)) 2 2)
			"\" SQUARE FEET AND NO. OF BLOCKS SELECTED ARE \"" (itoa (length alldata)) "\""))
	)
  )
 	(princ)
     )

 

Thank you

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×