topic Re: block match a specific value by which two-block in Visual LISP, AutoLISP and General Customization Forum

block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 06:12:59 GMT

Hello everyone, I have been working on this for a few days now with no success. I want to create a lisp by I want to select all attributes values block (name Tension length) and after selection, block match a specific value by which two-block getting a pair and as result paste their values in the specified place.

Prompt the user to get selected the blocks in the drawing.
Use their tag tension length to match the values with other blocks after finding the match values pair them and paste their values in a table.

PFA attached drawing file.

see the reference table in the end fo drawing.

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 08:09:23 GMT

@jaggisingh003 hi,

Hello everyone, I have been working on this for a few days now with no success.
show us what you have done so far?

Post another dwg that shows what is a 'match'? connect\wire a match (at least 2-3 examples)
is it possible that more then 2 block is a match?

show us exactly how these matches should be appear in the table (each instance on a line or one line for a match?)
how do you expect the lisp will spot the place (row, col) to place the match? cause your table is just ordinary simple lines.

Moshe

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 09:11:04 GMT

hello, @Moshe-A thanks for your quick response.

please view the attached images so your view about the program is clear. before this, I am using this program

in this i can select one block and paste their attribute value as text in tabel as per user selcted points.

i wote this :-

(defun c:W1()
(setq l1 (getvar "CLAYER"))
(command "._layer" "_M" "WIRE RUN-1" "")
(setvar 'CLAYER "WIRE RUN-1")
(setq g (car (entsel "\nSelect Block: ")))
(setq enlist(entget g))
(setq blkType(cdr(assoc 0 enlist))) ;- Save the type of entity
(if (= blkType "INSERT") ;- If the entity type is an Insert entity
(progn
(if(= (cdr(assoc 66 enlist)) 1);- See if the attribute flag equals one (if so, attributes follow)
(progn
(setq en1(entnext g));- Get the next sub-entity
(setq enlist1(entget en1));- Get the DXF group codes
(setq en2(entnext en1)) ;- Get the next sub-entity
(setq enlist2(entget en2))
(setq en3(entnext en2)) ;- Get the next sub-entity
(setq enlist3(entget en3))
(setq TL (cdr (assoc 1 enlist1)))
(setq LO (cdr (assoc 1 enlist2)))
(setq CH (cdr (assoc 1 enlist3)))
(setq point1 (getpoint "\n Selcted point for TL"))
(setq point2 (getpoint "\n Selcted point for LO"))
(setq point3 (getpoint "\n Selcted point for CH"))
(command "text" "j" "l" point1 2 0 TL)
(command "text" "j" "l" point2 2 0 LO)
(command "text" "j" "l" point3 2 0 CH)
(setvar 'CLAYER l1 )
)
)
)
)
)

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 10:24:31 GMT

@jaggisingh003,

to be honest i still do not understand what do you mean by match?

here is my corrections to your program, please note my comments.

enjoy

moshe

(vl-load-com) ; load activex support (defun c:W1 (/ get_attrib_value ; declare local function l1 ss l ename AcDbBlkRef val pt ;| local variables |; ) (defun get_attrib_value (ename tag / value) (setq subent (entnext ename) sube (entget subent)) (while (and (not value) (/= (cdr (assoc '0 sube)) "SEQEND") ) (if (eq (strcase (cdr (assoc '2 sube))) (strcase tag)) (setq value (cdr (assoc '1 sube))) ) (setq subent (entnext subent) sube (entget subent)) ); while value ); get_attrib_value ; here start c:W1 (setq l1 (getvar 'CLAYER)) (command "._layer" "_M" "WIRE RUN-1" "") ; No need for next call cause the "_make" option of layer command sets the new layer current ; (setvar 'CLAYER "WIRE RUN-1") ;|; Instead of the following block (setq g (car (entsel "\nSelect Block: "))) (setq enlist (entget g)) (setq blkType (cdr(assoc 0 enlist))) ;- Save the type of entity (if (= blkType "INSERT") ;- If the entity type is an Insert entity (progn (if (= (cdr(assoc 66 enlist)) 1);- See if the attribute flag equals one (if so, attributes follow) (progn (setq en1 (entnext g)) ;- Get the next sub-entity (setq enlist1 (entget en1));- Get the DXF group codes (setq en2 (entnext en1)) ;- Get the next sub-entity (setq enlist2 (entget en2)) (setq en3 (entnext en2)) ;- Get the next sub-entity (setq enlist3 (entget en3)) (setq TL (cdr (assoc 1 enlist1))) (setq LO (cdr (assoc 1 enlist2))) (setq CH (cdr (assoc 1 enlist3))) (setq point1 (getpoint "\nSelcted point for TL")) (setq point2 (getpoint "\n Selcted point for LO")) (setq point3 (getpoint "\n Selcted point for CH")) (command "text" "j" "l" point1 2 0 TL) (command "text" "j" "l" point2 2 0 LO) (command "text" "j" "l" point3 2 0 CH) ) ) ) )|; ; i would replace it with this block (code lines) ; instead of (entsel) use (ssget) cause it has filters, saves some data checking (if (setq ss (ssget ":S:E+." ; this arg is the same (entsel) '((0 . "insert") ; filter only block references (66 . 1)) ; has attributes ) ) ; loop through selected blocks, remember we are talking here only for 1 block (repeat (setq l (sslength ss)) (setq ename (ssname ss (setq l (1- l)))) ; get vlax-object cause the block is dynamic (setq AcDbBlkRef (vlax-ename->vla-object ename)) ; make sure we deal with "TENSION_LENGTH" block ; (vla-get-effectiveName) return the origin block name (not it's dynamic name) (if (eq (strcase (vla-get-effectiveName AcDbBlkRef)) "TENSION_LENGTH") ; loop through attributes tag in concern, a list of dotted pair items to also hold the key for the prompt to (getpoint) (foreach item '(("tension_length" . "TL") ("location_num" . "LO") ("chainage". "CH")) (if (and ; next, call a local function to get attribute value (or nil if it tag not found (setq val (get_attrib_value ename (car item))) (setq pt (getpoint (strcat "\nPick point for " (cdr item) ": "))) ) (command "._text" "_j" "_l" pt 2 0 val) ) ); foreach ); if (vlax-release-object AcDbBlkRef) ; dispose memory ); repeat ); if (setvar 'CLAYER l1 ) (princ) )

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 11:08:55 GMT

here are my corrections to your program, please note my comments.

@Moshe-A thanks for the corrections.

I m beginner top Autolisp programming so I don't know exactly how to execute the things.

@Moshe-A to be honest, I still do not understand what do you mean by match?

Ok if u see the drawings I had attached in my first post form the drawing you will get a block named "TENSION_LENGTH" with attributed values. I had used that block 4 times in that drawing.

from Four blocks two-block Tag "TENSION_LENGTH" (1386.00 value) have the same attribute value but other tag values are different.

So, I want to select all of them to get their tags values and match the "TENSION_LENGTH" tag between them and get the string from all Tags into the table already present in the drawing. like you see the table images in my second post.

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 11:23:08 GMT

like this attribute matching condition only "TENSION_LENGTH" TAG. try to match form all blocks attribute "TENSION_LENGTH" TAG. if match then pairs with that values and write all the values in this table.

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 12:17:24 GMT

Now you starting to be more clear 😀

is it possible that a match would be more than 2 blocks? (could it be 3 or 4?)

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 12:34:39 GMT

Yes, I think Sometime when there is a lot of details.

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 12:47:23 GMT

So would you know how many columns you need in table?!

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 13:09:18 GMT

@Moshe-A it is depend on the drawing some times it is more than 10 columns or sometimes only 3 columns is required.

see the attached image.

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 16:14:55 GMT

@jaggisingh003

it's was a bit challenge but i think i made it so give this a try 😀

the program let you select "TENSION_LENGTH" blocks and gather them by tension_length attribute

(if you select other objects they will be filtered out)

the prompt for picking points goes like this:

1386.00:location_num #1/2 <Pick point>:
1386.00:chainage #1/2 <Pick point>:

each step it notes you about the current tension_length + attribute name + #x/x (current attribute out of ...)

thus you will know how many columns in table is needed.

enjoy

Moshe

(vl-load-com) ; load activex support (defun c:W1 (/ tag-spiner get_attrib_value ; declare local functions TAGSNAME savCLayer ss len ename AcDbBlkRef val0 val1 val2 data^ ;| local variables |; ) (defun tag-spiner (n) (if (= n (length TAGSNAME)) 1 n) ); tag-spiner (defun get_attrib_value (ename tag / value) (setq subent (entnext ename) sube (entget subent)) (while (and (not value) (/= (cdr (assoc '0 sube)) "SEQEND") ) (if (eq (strcase (cdr (assoc '2 sube))) (strcase tag)) (setq value (cdr (assoc '1 sube))) ) (setq subent (entnext subent) sube (entget subent)) ); while value ); get_attrib_value ; here start c:W1 (setvar 'cmdecho 0) (command "._undo" "_begin") (setq savCLayer (getvar 'clayer)) (command "._layer" "_M" "WIRE RUN-1" "") (setq TAGSNAME '("tension_length" "location_num" "chainage")) (if (setq ss (ssget '((0 . "insert") (66 . 1)))) (progn ; build databse (repeat (setq len (sslength ss)) (setq ename (ssname ss (setq len (1- len)))) (setq AcDbBlkRef (vlax-ename->vla-object ename)) (if (and (eq (strcase (vla-get-effectiveName AcDbBlkRef)) "TENSION_LENGTH") (setq val0 (get_attrib_value ename (nth 0 TAGSNAME))) (setq val1 (get_attrib_value ename (nth 1 TAGSNAME))) (setq val2 (get_attrib_value ename (nth 2 TAGSNAME))) ) (if (assoc val0 data^) (progn (setq item (assoc val0 data^)) ; store existing item (setq data^ (append (reverse (cdr (member item (reverse data^)))) (cdr (member item data^)))) ; chop existing item (setq data^ (cons (cons val0 (list (cadr item) (list val1 val2))) data^)) ; add new item ); progn (setq data^ (cons (list val0 (list val1 val2)) data^)) ); if ); if (vlax-release-object AcDbBlkRef) ; dispose memory ); repeat ; insert attributes value as text (foreach item0 data^ (setq i 0) (foreach item1 (cdr item0) (setq j 0 i (1+ i)) (foreach item2 item1 (if (setq pt (getpoint (strcat "\n" (car item0) ":" (nth (setq j (tag-spiner (1+ j))) TAGSNAME) " #" (itoa i) "/" (itoa (length item1)) " <Pick point>: "))) (command "._text" "_j" "_l" pt 2 0 item2) ) ); foreach ); foreach (setq i 0) (foreach item1 (cdr item0) (if (setq pt (getpoint (strcat "\n" (car item0) ":" (nth 0 TAGSNAME) " #" (itoa (setq i (1+ i))) "/" (itoa (length item1)) " <Pick point>: "))) (command "._text" "_j" "_l" pt 2 0 (car item0)) ) ); foreach ); foreach ); progn ); if (setvar 'clayer savCLayer) (command "._undo" "end") (setvar 'cmdecho 1) (princ) )

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 17:15:13 GMT

@Moshe-A you are great. thanks for this help thanks a lot.

this will save my time. again thanks for this.

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 17:17:53 GMT

@Moshe-A one more help can you just explain this code in simple language.

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 17:44:17 GMT

be more specific

Re: block match a specific value by which two-block

jaggisingh003 — Sat, 11 Apr 2020 18:03:51 GMT

what is this?

 (defun tag-spiner (n)
  (if (= n (length TAGSNAME)) 1 n)
 ); tag-spiner

Re: block match a specific value by which two-block

Moshe-A — Sat, 11 Apr 2020 19:18:25 GMT

first i made some fine tuning, hope you do not mind 😀

about your question:

the index of items in list is zero based. meaning the first is 0, second is 1, third is 2 ....etc

(setq TAGSNAME '("tension_length" "location_num" "chainage"))

so the above expr result "tension_length" is index 0, "location_num is index 1 and "chainage" is index 2.

for example: by selection 2 "TENSION_LENGTH" blocks with match "tension_length" attributes value, may result the following list: (("1386.00" ("160/10" "160/615.00") ("185/15" "185/815.00")))

now, when i process it to draw the texts (due to the order of columns in your table) i first needed the "location_num" attribute then the "chainage" than again i need next "location_num" + "chainage" (and if there were more...i need it again and again) so when looping through TAGSNAME i need to skip the first item. there i defined the (tag_spiner) function to return the right index item so if the args n reach 3 it should go back to second item which is 1 (not 0).

if you have more question do not hesitate to ask.

Moshe

(vl-load-com) ; load activex support (defun c:W1 (/ block_attrib_list build_data_list tag-spiner get_attrib_value draw_text ; declare local functions TAGSNAME savCLayer ss len ename AcDbBlkRef lst data^ ;| local variables |; ) (defun block_attrib_list (ent) (vl-remove-if 'not (mapcar '(lambda (tag) (get_attrib_value ent tag) ) TAGSNAME ); mapcar ) ); block_attrib_list (defun build_data_list (/ item) (if (assoc (nth 0 lst) data^) (progn (setq item (assoc (nth 0 lst) data^)) ; store existing item (setq data^ (append (reverse (cdr (member item (reverse data^)))) (cdr (member item data^)))) ; chop existing item (setq data^ (cons (cons (nth 0 lst) (list (cadr item) (list (nth 1 lst) (nth 2 lst)))) data^)) ; add new item ); progn (setq data^ (cons (list (nth 0 lst) (list (nth 1 lst) (nth 2 lst))) data^)) ); if ); build_data_list (defun tag-spiner (n) (if (= n (length TAGSNAME)) 1 n) ); tag-spiner (defun get_attrib_value (ename tag / value) (setq subent (entnext ename) sube (entget subent)) (while (and (not value) (/= (cdr (assoc '0 sube)) "SEQEND") ) (if (eq (strcase (cdr (assoc '2 sube))) (strcase tag)) (setq value (cdr (assoc '1 sube))) ) (setq subent (entnext subent) sube (entget subent)) ); while value ); get_attrib_value (defun draw_text (item0 item1 item2 j i text / pt) (if (setq pt (getpoint (strcat "\n" (car item0) ":" (nth j TAGSNAME) " #" (itoa i) "/" (itoa (length item1)) " <Pick point>: "))) (command "._text" "_j" "_l" pt 2 0 text) ) ); draw_text ; here start c:W1 (setvar 'cmdecho 0) (command "._undo" "_begin") (setq savCLayer (getvar 'clayer)) (command "._layer" "_M" "WIRE RUN-1" "") (setq TAGSNAME '("tension_length" "location_num" "chainage")) (if (setq ss (ssget '((0 . "insert") (66 . 1)))) (progn (mapcar '(lambda (ename) (setq AcDbBlkRef (vlax-ename->vla-object ename)) (if (eq (strcase (vla-get-effectiveName AcDbBlkRef)) "TENSION_LENGTH") (progn (setq lst (block_attrib_list ename)) (setq data^ (build_data_list)) ); progn ); if (vlax-release-object AcDbBlkRef) ); lambda (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ); mapcar ; insert attributes value as text (foreach item0 data^ (setq i 0) (foreach item1 (cdr item0) (setq j 0 i (1+ i)) (foreach item2 item1 (draw_text item0 item1 item2 (setq j (tag-spiner (1+ j))) i item2) ); foreach ); foreach (setq i 0) (foreach item1 (cdr item0) (draw_text item0 item1 nil 0 (setq i (1+ i)) (car item0)) ); foreach ); foreach ); progn ); if (setvar 'clayer savCLayer) (command "._undo" "end") (setvar 'cmdecho 1) (princ) )

Re: block match a specific value by which two-block

Sea-Haven — Sun, 12 Apr 2020 02:39:50 GMT

Moshe-A re how many columns required had the same problem in a task playing with various blocks up to 25 attributes, so made a list of the atts ((blk1 2 3 4)(blk2 1 2 3 4 5 6 )(………… so just looked at the length of each individual list and this gave the number of columns required

Re: block match a specific value by which two-block

Moshe-A — Sun, 12 Apr 2020 08:48:06 GMT

@jaggisingh003 ,

found a bug, here is the fix

Re: block match a specific value by which two-block

jaggisingh003 — Sun, 12 Apr 2020 08:58:09 GMT

found a bug, here is the fix.

@Moshe-A you are so good that you can found a bug in this.

but here I can't even understand the code properly so in future I can do something like that other attributes blocks.🙄🙄🙄🙄😣

Re: block match a specific value by which two-block

Moshe-A — Sun, 12 Apr 2020 09:31:48 GMT

it's totally obvious, you are only a beginner. as long as you keep trying eventually you will catch it.

success will come in 'sweat' 😀