rlx Posted July 27, 2021 Share Posted July 27, 2021 replace (with _) , yes , yes , you're welcome Quote Link to comment Share on other sites More sharing options...
hpimprint Posted July 28, 2021 Author Share Posted July 28, 2021 i tryed it but it does not work. here autocad message: ; error: Automation Error. Key not found Command: here attached the lisp file i used. ah! _thank *you blockschangenameandlayer.lsp Quote Link to comment Share on other sites More sharing options...
rlx Posted July 28, 2021 Share Posted July 28, 2021 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) Quote Link to comment Share on other sites More sharing options...
hpimprint Posted July 29, 2021 Author Share Posted July 29, 2021 it works perfectly. great script, nice work. compliments. 1 Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 9, 2021 Author Share Posted November 9, 2021 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted November 9, 2021 Share Posted November 9, 2021 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) ) Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 15, 2021 Author Share Posted November 15, 2021 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted November 15, 2021 Share Posted November 15, 2021 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. Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 15, 2021 Author Share Posted November 15, 2021 ok. i will wait for you Quote Link to comment Share on other sites More sharing options...
rlx Posted November 15, 2021 Share Posted November 15, 2021 this one I made a while ago , not sure what is does exactly anymore but maybe it also works for you. Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 17, 2021 Author Share Posted November 17, 2021 there is maybe a bug in the script to change layer names. Here attached the last script and a test .dwg where inside are shown blocks that are not renamed by script. RENAME_PROBLEM.dwg blockschangenameandlayer v.4.0.lsp Quote Link to comment Share on other sites More sharing options...
rlx Posted November 18, 2021 Share Posted November 18, 2021 (edited) 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 (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 November 18, 2021 by rlx Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 23, 2021 Author Share Posted November 23, 2021 i tested it. autocad message is: ; error: Automation Error. Key not found Command: Quote Link to comment Share on other sites More sharing options...
rlx Posted November 23, 2021 Share Posted November 23, 2021 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 Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 23, 2021 Author Share Posted November 23, 2021 (edited) it doesn't work at all. ; error: bad argument type: stringp T here attached the test file, if you want to test it test per stress.3 originale.dwg Edited November 23, 2021 by hpimprint Quote Link to comment Share on other sites More sharing options...
rlx Posted November 23, 2021 Share Posted November 23, 2021 (edited) 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 November 23, 2021 by rlx Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 26, 2021 Author Share Posted November 26, 2021 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. Quote Link to comment Share on other sites More sharing options...
rlx Posted November 26, 2021 Share Posted November 26, 2021 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. Quote Link to comment Share on other sites More sharing options...
hpimprint Posted November 26, 2021 Author Share Posted November 26, 2021 ok thank you. so this topic is solved and stops here thank you again, you saved me! Quote Link to comment Share on other sites More sharing options...
hpimprint Posted December 22, 2021 Author Share Posted December 22, 2021 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.