Leaderboard

The above could alternatively be written: (defun LM:data->xdata ( x ) (cond ( (= 'str (type x)) (list (cons (if (handent x) 1005 1000) x))) ( (= 'real (type x)) (list (cons 1040 x))) ( (= 'int (type x)) (list (cons (if (< -32769 x 32768) 1070 1071) x))) ( (= 'list (type x)) (append '((1002 . "{")) (apply 'append (mapcar 'LM:data->xdata x)) '((1002 . "}")))) ( (list (cons 1000 (vl-prin1-to-string x)))) ) )

(if (and (or (tblsearch "BLOCK" "STREET2") (alert "Block < STREET2 > was not found <!>") ) (or *sclval* (setq *sclval* 1.0)) (setq *sclval* (cond ((getdist (strcat "\nSpecify the scale value < " (vl-princ-to-string *sclval*) " > : " ) ) ) (*sclval*) ) ) ) (while (setq p (getpoint "\nSpecify point :")) (vla-put-textstring (car (vlax-invoke (vla-insertblock sp (vlax-3d-point p) "STREET2" *sclval* *sclval* *sclval* 0.0 ) 'getattributes ) ) (rtos (/ (caddr p) 1000.) 2 2) ) ) )

You could try something like this - (defun c:crd ( / ang att blk ins obj scl spc ) (setq blk "street2") (if (tblsearch "block" blk) (progn (if (null crd:scl) (setq crd:scl 1.0) ) (initget 6) (if (setq scl (getreal (strcat "\nSpecify scale <" (rtos crd:scl 2) ">: "))) (setq crd:scl scl) (setq scl crd:scl) ) (setq ang (angle '(0 0) (trans (getvar 'ucsxdir) 0 (trans '(0 0 1) 1 0 t) t)) spc (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace) ) ) (while (setq ins (getpoint "\nSpecify insertion point <exit>: ")) (if (setq obj (vla-insertblock spc (vlax-3D-point (trans ins 1 0)) blk scl scl scl ang) att (car (vlax-invoke obj 'getattributes)) ) (vla-put-textstring att (rtos (/ (caddr (trans ins 1 0)) 1000.0) 2 2)) ) ) ) (princ (strcat "\nBlock " blk " is not defined in the active drawing.")) ) (princ) ) (vl-load-com) (princ)

thanks perfect!

Lineweight is 370 So I did the same thing as 6 (linetype) for 370. Skipping ByLayer , which means it doesn't have a 370 (but byBlock or default is not a problem, I think). Lines 73->77 See if it does what you need. Try testing it for difficult cases, put in a few byLayer, byBlock, default, ... ;; 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 (if (not (assoc 370 edata)); Bylayer; [no Linetype override] ;; don't override ByLayer (setq edata (append edata (list (assoc 370 ldata)))); then -- assign Layer's lineweight ); 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 BN0 to change all selected Blocks' Entities to Layer 0 retaining their Layers' color/linetype/lineweight.")