move blocks to other (new) layer by TWO attribute values

[hpimprint]

I have many blocks.

 

if i double click on a block it open the "enchanced attribute edfitor" and i see:

TAG1: systemId (having a value, example: TFS)

TAG2: Keyworld (having a value, example: donalduck )

TAG3: Description (having a value, example: animal)

TAG4:dimensionalDescription (having a value, example: 50x5.54 t80)

TAG5: PipelineID  (having a value, example: 300-767)

 

Actually every block is in a different layer having the same name of TAG1.

in the example above the block is in layer "TFS".

 

I need to put every block in new layers having the name "TAG1-TAG5": in the example above the block should go in layer "TFS-300-767". (note the added "-" between TAG1 (TFS) and TAG5 (300-767))

 

can you help me?

 

thank you

 

 

 

 

[rlx]

like this? I used "tst" for block name (setq bn "tst"), so you have to put your own blockname there

 

;;; get attibute value (vla version)
(defun gav (b a) (setq a (strcase a))
  (vl-some '(lambda (x)(if (= a (strcase (vla-get-tagstring x)))(vla-get-textstring x)))(vlax-invoke b 'getattributes)))

;selectionset to (object) list
(defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)

; create layer test : (cl "RLX")
(defun cl (lay) (if (not (tblsearch "layer" lay))(entmake (list (cons 0 "LAYER")
  (cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 lay) (cons 70 0)))))

(defun c:t1 ( / bn ss a1 a5 l) (vl-load-com) (setq bn "tst") (if (setq ss (ssget "x"
  (list (cons 0 "insert") (cons 2 bn))))(foreach b (ss->ol ss)(setq a1 (gav b "TAG1") a5 (gav b "TAG5"))
   (if (and a1 a5 (snvalid a1) (snvalid a5))(progn (cl (setq l (strcat a1 "-" a5)))(vla-put-layer b l))))))

 

Edited July 19, 2021 by rlx

[BIGAL]

Just a suggestion gets around block name. Note non dynamic block.

 

(setq bn "tst")

replace with
(setq bn (cdr (assoc 2 (entget (car (entsel "Pick a block "))))))

 

[confutatis]

For the selection you can also do this:

 

(defun SS->OL (ss) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp  (mapcar 'cadr (ssnamex ss)))))

 

[hpimprint]

9 hours ago, rlx said:

like this? I used "tst" for block name (setq bn "tst"), so you have to put your own blockname there

 

;;; get attibute value (vla version)
(defun gav (b a) (setq a (strcase a))
  (vl-some '(lambda (x)(if (= a (strcase (vla-get-tagstring x)))(vla-get-textstring x)))(vlax-invoke b 'getattributes)))

;selectionset to (object) list
(defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)

; create layer test : (cl "RLX")
(defun cl (lay) (if (not (tblsearch "layer" lay))(entmake (list (cons 0 "LAYER")
  (cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 lay) (cons 70 0)))))

(defun c:t1 ( / bn ss a1 a5 l) (vl-load-com) (setq bn "tst") (if (setq ss (ssget "x"
  (list (cons 0 "insert") (cons 2 bn))))(foreach b (ss->ol ss)(setq a1 (gav b "TAG1") a5 (gav b "TAG5"))
   (if (and a1 a5 (snvalid a1) (snvalid a5))(progn (cl (setq l (strcat a1 "-" a5)))(vla-put-layer b l))))))

 

 

[hpimprint]

thank you, i will try it tomorrow

 

1)in this lisp i have to replace "TAG1" and "TAG2" with "systemId" and "PipelineID" (with " or without "?)?

2)have next names to remain unchanged? "layer", "LAYER", "RLX", "insert", "x", "AcDbSymbolTableRecord". Or have i to replace with something?

 

2)does this lisp apply automatically to all blocks in drawing? (they are maaaAAAAaaany so i can't select one by one by hand). have i to select all blocks and then activate lisp or i direclty activate lisp without any block selection?

 

here attached an example of blocks in my dwg file so you can see the tags in enchanced blocks..

 

 

test.zip

[hpimprint]

To use the lisp, i have to write this?

 

(defun c:blockschangenameandlayer ()

 

---here i copy your code---

 

)

[rlx]

totally untested :

;;; get attibute value (vla version)
(defun gav (b a) (setq a (strcase a))
  (vl-some '(lambda (x)(if (= a (strcase (vla-get-tagstring x)))(vla-get-textstring x)))(vlax-invoke b 'getattributes)))

;selectionset to (object) list
(defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)

; create layer test : (create_layer "RLX")
(defun create_layer (lay) (if (not (tblsearch "layer" lay))(entmake (list (cons 0 "LAYER")
  (cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 lay) (cons 70 0)))))

(defun c:blockschangenameandlayer ( / ss tag1 tag2 lay)
  (if (setq ss (ssget "x" '((0 . "insert"))))
    (foreach block (ss->ol ss)
      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID"))
      (if (and tag1 tag2 (snvalid tag1) (snvalid tag2))
        (progn
          (create_layer (setq lay (strcat tag1 "-" tag2)))
          (vla-put-layer block lay)
        )
      )
    )
  )
  (princ)
)

(vl-load-com)

(defun c:bcnl ()(c:blockschangenameandlayer))

(princ "\nOn commandline (after loading lisp) type blockschangenameandlayer (or bcnl for short) to run program")
(princ)

 

Edited July 20, 2021 by rlx

[hpimprint]

unfortunately it does not work

autocad command line says:

"; error: bad point argument
Command:"

[rlx]

Oh I'm sorry , my mistake ... should have tested this instead of typing it directly into this thread , made a little typo but I've updated the code above. Code should run now

Edited July 20, 2021 by rlx

[hpimprint]

ok thank you. it works but partially .

if you disable a layer the object don't disappear because the parts inside the block still have the old layer.

how can i ALSO change layer to objects  inside block, giving them the same layer of main block they are inside?

 

[rlx]

My next question was gonna be , what do you hope to gain with this , you have 7700+ blocks , one for each pipe or valve , and you might end up with 7700+ layers. Search this site for routine to change all entities inside block to color bylayer or byblock. Should be plenty around. Now I come to think about it , a while back I posted something to change all block entities to color byblock whatever... would have to search what / when it was...

[rlx]

this one :

 

[hpimprint]

"what do you hope to gain with this , you have 7700+ blocks , one for each pipe or valve , and you might end up with 7700+ layers"

 

really i hope everything inside a block (pipe, valve,...) will go to the same block.

 

example: you have a block (having tag1= CWS and tag2= 100-101) containing 4 nested objects. at the end i hope to have them all to the new layer CWS-100-101.

 

If there is a second block having same tag1 and tag2, all nested objects (and the block itaself) should go to same layer CWS-100-101.

 

so the layer CWS-100-101 will contain the old 2 blocks with all their content.

 

in this way if i disable the layer CWS-100-101, all above objects will disappear.

 

this was my idea.

.

[hpimprint]

i tryed the lisp in the link above but it does not work on my file.

Edited July 20, 2021 by hpimprint

[hpimprint]

for this second problem better move to

 

[hpimprint]

the lisp works BUT not always.

 

If in the tag "PipelineID" there is a "*" symbol, when lisp meet that objects the layer layer analisys stops and start working on next layer. so some items remain unchanged in the "half-worked" layer.

Here attached an example.

UP there is the original layer you can test lisp on.

DOWN my actual result.

 

thank you

 

yyy.zip

[hpimprint]

no ideas?

[rlx]

look up snvalid and you'll find that not all characters are allowed (\\<>/?\":;*|,=`) so * symbol is a no-no

 

only way to fix this is to change the block or replace invalid characters with underscore or any other valid character. You can change (snvalid tag1) (snvalid tag2)  in program with alternative version (validsn tag1) (validsn tag2) and add this tiny lisp code to your program :

;;; test (validsn "abc") (validsn "a\\b<c>d/e?f\"g:h;i*j|k,l=m`n")
(defun validsn ( s / n ) (if (and (= (type s) 'STR) (setq n (vl-string->list "\\<>/?\":;*|,=`")))
  (apply 'strcat (mapcar '(lambda (x)(if (member x n) "_" (chr x))) (vl-string->list s))) nil))

 

Edited July 27, 2021 by rlx

[hpimprint]

thank you.

1)this tiny lisp code will delete the invalid characters or will replace them with something other?

2) this list tiny code will work also if invalid character is not the first character? it will work with *text, te*xt, text* the same?

3) this list tiny code will work if there are more then one invalid character in a word? example: *te*xt or *te&xt$

 

thank *you

 

Edited July 27, 2021 by hpimprint