Search the Community

;; BN0.lsp [command name the same] ;; = change all Block Entities [other than on Layer Defpoints] in selected Blocks' ;; definitions, including in any Nested Blocks, to Layer 0 with Color & Linetype ;; overrides from entity's source layer properties [if not otherwise overridden] ;; Kent Cooper, last edited 4 November 2014 (vl-load-com) (defun C:BN0 (/ *error* nametolist doc blkss inc blokobj blkname blknames ent edata ldata) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); if (vla-endundomark doc) (princ) ); defun - *error* (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref (progn (setq blkobj (vlax-ename->vla-object blk) blkname (vlax-get-property blkobj (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name) ; to work with older versions that don't have dynamic Blocks ); ...get-property & blkname ); setq (if (not (member blkname blknames)); name not already in list (setq blknames (append blknames (list blkname))); then -- add to end of list ); if ); progn ); if ); defun -- nametolist (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc); = Undo Begin (if (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs (progn; then (repeat (setq inc (sslength blkss)); list of Block names from top-level selection (nametolist (ssname blkss (setq inc (1- inc)))) ); repeat (while (setq blk (car blknames)); as long as there's another Block name in list ;; [this way instead of via (repeat) or (foreach), so it can add Nested Blocks' names to list] (setq ent (tblobjname "block" blk)); Block definition as entity (if (= (logand (cdr (assoc 70 (entget ent))) 4) 0) ; not an Xref (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition (setq edata (entget ent)) (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints (progn ; then (setq ldata (entget (tblobjname "layer" (cdr (assoc 8 edata))))); entity's Layer's properties (if (or ; [no Color override] (not (assoc 62 edata)); Bylayer (member '(62 . 0) edata); Byblock ); or (setq edata (append edata (list (assoc 62 ldata)))); then -- assign Layer's color ); if (if (and (or ; [no Linetype override] (not (assoc 6 edata)); Bylayer (member '(6 . "ByBlock") edata) ); or (not (member '(6 . "Continuous") ldata)) ; don't override ByLayer/ByBlock with Layer's linetype if Continuous ); and (setq edata (append edata (list (assoc 6 ldata)))); then -- assign Layer's linetype ); if (setq edata (subst '(8 . "0") (assoc 8 edata) edata)); to Layer 0 (entmod edata) ); progn -- then ); if -- not on Defpoints ); while -- sub-entities ); if (setq blknames (cdr blknames)); take first Block name off list ); while (command "_.regen") ); progn (prompt "\nNo Block(s) selected."); else ); if [user selection] (vla-endundomark doc); = Undo End (princ) ); defun (prompt "\nType BENL0CL to change all selected Blocks' Entities to Layer 0 retaining their Layers' color/linetype.") hello i have this lisp that in nanocad pro don't work.... any suggestion? give me: COM NOT_IMPLEMENTED CDocumentObj::StartUndoMark