srinak47 Posted January 21, 2014 Share Posted January 21, 2014 Hi this one work so great,,, i like it so much... am seeking for one modification in this... Block entities are perfectly changing to "0" layer, but Block remain in same layer i wanted block also to change in "Desired Layer" or "0" Layer... And if possible Nested block and Nested Entities to "0" Layer or to "Desired Layer" thanks Ah, that's my mistake... Changed code is:(defun c:norm (/ *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def (vla-put-layer ent "0") (vla-put-color ent 0) (vla-put-lineweight ent aclnwtbyblock) (vla-put-linetype ent "byblock") ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
lucas3 Posted February 12, 2014 Share Posted February 12, 2014 Ah, that's my mistake... Changed code is:(defun c:norm (/ *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def (vla-put-layer ent "0") (vla-put-color ent 0) (vla-put-lineweight ent aclnwtbyblock) (vla-put-linetype ent "byblock") ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun Does not support Mosaic block? Drawing155.dwg version:A2010 Quote Link to comment Share on other sites More sharing options...
kpblc Posted February 12, 2014 Share Posted February 12, 2014 No. I you want to proceed blocks in blocks, try this code: (defun c:norm2 (/ *error* adoc lst_layer func_restore-layers fun_get-block-subref-by-block) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun fun_get-block-subref-by-block (blk-name) (setq res (list blk-name)) (vlax-for subent (vla-item (vla-get-blocks adoc) blk-name) (if (wcmatch (strcase (vla-get-objectname subent)) "*BLOCK*") (setq res (append res (fun_get-block-subref-by-block (vla-get-name subent)))) ) ;_ end of if ) ;_ end of vlax-for res ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (apply (function append) (mapcar (function (lambda (x) (fun_get-block-subref-by-block (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar ) ;_ end of apply (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def (vla-put-layer ent "0") (vla-put-color ent 0) (vla-put-lineweight ent aclnwtbyblock) (vla-put-linetype ent "byblock") ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
lucas3 Posted February 13, 2014 Share Posted February 13, 2014 No. I you want to proceed blocks in blocks, try this code: (defun c:norm2 (/ *error* adoc lst_layer func_restore-layers fun_get-block-subref-by-block) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun fun_get-block-subref-by-block (blk-name) (setq res (list blk-name)) (vlax-for subent (vla-item (vla-get-blocks adoc) blk-name) (if (wcmatch (strcase (vla-get-objectname subent)) "*BLOCK*") (setq res (append res (fun_get-block-subref-by-block (vla-get-name subent)))) ) ;_ end of if ) ;_ end of vlax-for res ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (apply (function append) (mapcar (function (lambda (x) (fun_get-block-subref-by-block (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar ) ;_ end of apply (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def (vla-put-layer ent "0") (vla-put-color ent 0) (vla-put-lineweight ent aclnwtbyblock) (vla-put-linetype ent "byblock") ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun Thanks kpblc ,very nice! but I find that,color attribute change from bylayer to byblock, Quote Link to comment Share on other sites More sharing options...
Zagerot Posted October 15, 2014 Share Posted October 15, 2014 Can anybody help in excluding the defpoints layer from the selection change? Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted May 10, 2016 Share Posted May 10, 2016 This thread is a good example of the point I'll make ... Is there a way to highlight the post with the best working code? I copy/pasted this code, I forgot which version of the code. And I added some code (xref layers were still being processed ...). It's hard to add code, and let everybody know what I did, because in the mean time other changes have been made. I understand this is a forum (it's not Github or so) ... but still Quote Link to comment Share on other sites More sharing options...
ChristopherM Posted June 23, 2016 Share Posted June 23, 2016 Thank you for this Was helpful for me as well in 2016 June Quote Link to comment Share on other sites More sharing options...
John_in_NZ Posted July 6, 2020 Share Posted July 6, 2020 Someone commented that the lisp that KPBLC created was the best thing since flushing toilets. I'd go further, I think it's the best thing since sliced bacon, and I really cannot believe that it's taken me so long to find this routine. Dealing with dwg exports from Archicad, this will save me a massive amount of time. Thank you very much indeed ... 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.