Jump to content

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


hpimprint

Recommended Posts

try it now (result of tag1 and tag2 should not only be tested but also saved like :

      (if (and tag1 tag2 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)))

 

;;; 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)))))

;;; 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))

(defun c:blockschangenameandlayer ( / ss tag1 tag2 lay)
  (if (setq ss (ssget "x" '((0 . "insert"))))
    (foreach block (ss->ol ss)
      ;;; qui definisce cosa sono tag1 e tag2 tra le proprietà del blocco
      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID")) 
      (if (and tag1 tag2 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)))
        (progn
          ;;; qui crea il layer con il nuovo nome tag1 - tag2 dove tag1 e tag2 sono presi dal blocco
          (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)

 

Link to comment
Share on other sites

  • 3 months later...

here i am again.

can i ask for a lisp change?

let's remeber that in the starting autocad drawing blocks we have the following attributes:
Systemld = xxx
keyword = yyy
Description
dimensionalDescription
PipelineId = zzz


actually we created layers "SystemId-PipelineId" (putting the right blocks inside) using "systemId" and "PipelineID" block attributes.

now i have some blocks having a specific "keyword" attribute =SUPPORT:
Systemld =xxx
keyword = SUPPORT
Description
dimensionalDescription
PipelineId =zzz

now i need to put objects having attribute keyword = SUPPORT in a different layer named "SystemId-PipelineId-SUPPORT"
while all other objects wll go, as per old script, in layer named "SystemId-PipelineId".

 

i think is possible to insert an "IF...ELSE" condition in script file:

 

actual script:
-------------
      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID"))
      (if (and tag1 tag2 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)))
        (progn
          (create_layer (setq lay (strcat tag1 "-" tag2)))
          (vla-put-layer block lay)
        )

 

 

new script:
----------

      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID") tag3 (gav block "keyword")
(***) (IF "keyword" ATTRIBUTE IS EQUAL TO "SUPPORT"
    if (and tag1 tag2 tag3 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)) (setq tag3 (validsn tag3)) )
        (progn
          (create_layer (setq lay (strcat tag1 "-" tag2 "-" tag3)))
          (vla-put-layer block lay)
        )
(***)    ELSE
      (if (and tag1 tag2 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)))
        (progn
          (create_layer (setq lay (strcat tag1 "-" tag2)))
          (vla-put-layer block lay)
        )


can you help me to write the IF.. ELSE condition, look at (***)?

thank you

 

Link to comment
Share on other sites

untested

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

 

Link to comment
Share on other sites

thank you. it worked.

 

but what if i need that only layers "#-@-SUPPORT" have colour by layer also for objects inside block?

Now if i have a main block on layer "(HCV)-100-007-SUPPORT", its color is "by layer" but nested objects inside block have a forced color: so also if i change main block layer color, the block remain of same color.

Is it possible to force objects inside main block on layers "#-@-SUPPORT" so to have forced color "by layer"? probebly you can to it while you create the new layer name and move on it the block.

 

see attached file

nested objects inside SUPPORT layers color change to by layer.dwg

Link to comment
Share on other sites

think there are many posts about nested blocks and color byblock on this forum so you shoud be able to find one and modify it to your need. Have some work to finish now , but will look later.

Link to comment
Share on other sites

Sorry for the late reaction, have very little time at this moment (end of year stress / no pressure you know...)

First look tells me value for pipelineID contains invalid character (*) for it to be able to be used as layer name , like 100-PWA-MAN2*

I assumed validsn would replace each invalid character with "_" but apparently it doesn't. Will look later if I have more time 😓

 

ah , rookie mistake :oops:

 

(defun c:blockschangenameandlayer ( / ss tag1 tag2 tag3 lay)
  (if (setq ss (ssget "x" '((0 . "insert"))))
    (foreach block (ss->ol ss)
      ;;; qui definisce cosa sono tag1, tag2 e tag3 tra le proprietà del blocco
      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID") tag3 (gav block "keyword"))
      (if (and tag1 (setq tag1 (validsn tag1)) tag2 (setq tag2 (validsn tag2)))
        (cond
          ((and tag3 (setq tag3 (validsn tag3)) (eq (strcase tag3) "SUPPORT"))
	     ;;; se keyword=SUPPORT aggiunge al nome layer "-SUPPORT"
             (create_layer (setq lay (strcat tag1 "-" tag2 "-" tag3))) (vla-put-layer block lay))
          (t (create_layer (setq lay (strcat tag1 "-" tag2))) (vla-put-layer block lay))
        )
      )
    )
  )
  (princ)
)

 

🐉

Edited by rlx
Link to comment
Share on other sites

I only changed 

(and tag1 tag2 (snvalid tag1) (snvalid tag2))

to

(and tag1 tag2 (setq tag1 (snvalid tag1)) (setq tag2 (snvalid tag2)))

 

and same for tag3

 

did you replace posted version part in your v.4.0.lsp or just tried to run it? Anyways , attached the full version. If it still gives you trouble let me know and I will create one with more error catching / messages

blockschangenameandlayer_nov_2021.lsp

Link to comment
Share on other sites

well this certainly showed me the need to always test something before posting, sorry about that...

try it now...

 

;;; 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)))))

;;; 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))

(defun c:blockschangenameandlayer ( / ss tag1 tag2 tag3 lay)
  (if (setq ss (ssget "x" '((0 . "insert"))))
    (foreach block (ss->ol ss)
      ;;; qui definisce cosa sono tag1, tag2 e tag3 tra le proprietà del blocco
      (setq tag1 (gav block "systemId") tag2 (gav block "PipelineID") tag3 (gav block "keyword"))
      (if (and tag1 tag2 (setq tag1 (validsn tag1)) (setq tag2 (validsn tag2)))
        (cond
          ((and tag3 (setq tag3 (validsn tag3)) (eq (strcase tag3) "SUPPORT"))
	     ;;; se keyword=SUPPORT aggiunge al nome layer "-SUPPORT"
             (create_layer (setq lay (strcat tag1 "-" tag2 "-" tag3))) (vla-put-layer block lay))
          (t (create_layer (setq lay (strcat tag1 "-" tag2))) (vla-put-layer block lay))
        )
      )
    )
  )
  (princ)
)

(vl-load-com)

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

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

 

Edited by rlx
Link to comment
Share on other sites

perfect! now it works well. SOLVED! :) :) :) thank you

 

in your scripts, perhaps do you know how to set layer of nested objects inside blocks to "by block"?

i mean: all objects should have "by block" as colour.

 

Link to comment
Share on other sites

Only thing I have  at this moment for setting objects to color byblock ,  I posted nov 15. It used to work for me but I admid I rarely have to use it. Maybe start new topic and include a drawing with before and after situation , not just a pic.

But I'm happy at least the other one works at last. 👍:beer:

Link to comment
Share on other sites

  • 4 weeks later...

dear rlx :)

i used the lisp on a HUGE dwg file containing more than 1000.000 (!!!) blocks..... and lisp stopped working (error, something as "access violation"): i think autocad lisp cache memory ended. infact separating the huge file in two files (each one containg an half of blocks), lisp worked.

Is there  way to modify the script so that it can work also on huge dwg contaianin maaaAAAaany blocks?

thank you

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...