Leaderboard

@mhupp FWIW ;; This (foreach blk (mapcar 'cadr (ssnamex ss)) (setq ed (entget blk) ed (subst (cons 8 (car ent)) (assoc 8 ed) ed) ed (subst (cons 41 (cadr ent)) (assoc 41 ed) ed) ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed) ed (subst (cons 43 1) (assoc 43 ed) ed) ) (entmod ed) ) ;; Can be written like this (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (list (cons 8 (car ent)) (cons 41 (cadr ent)) (cons 42 (caddr ent)) (cons 43 1)) ) ) ) ;; Or this too :) (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car ent) (cadr ent) (caddr ent) 1))) ) ) Assuming I didn't fat finger something

Hi Here is a simple function, works for any nesting level (defun replace_sublist (lst old new) (mapcar (function (lambda (x) (cond ((equal x old) new) ((atom x) x) (T (replace_sublist x old new)) ) ) ) lst ) ) And some tests _$ (setq number2 (list 1 (list 2 (list 3 (list 4 5))) 7)) (1 (2 (3 (4 5))) 7) _$ (replace_sublist number2 5 (list 5 6)) (1 (2 (3 (4 (5 6)))) 7) _$ (replace_sublist number2 7 (list 7 8)) (1 (2 (3 (4 5))) (7 8)) _$ (replace_sublist number2 (list 4 5) 4) (1 (2 (3 4)) 7) _$

I don't know exactly how to explain it.. either I will look brilliant by saying what I think or everyone will say "no it's not that at all you fool". Anyway I think it is all to do with moving along the nested lists until there is no more lists but it can't then 'un-nest' back up the levels.. I think... So what I thought is you might need to explicitly loop through each item in the list and analyse that as you loop through and repeat as you come to a new nested list, when that nested list is finished the loop moves onto the next item in its parent list.. or something like that Anyway, you could try this: (defun testlist (mylist mysearchterm myreplace / Newlist) (defun checklist ( alist mysearchterm myreplace / acount mylist) (defun LM:SubstNth ( a n l ) (if l (if (zerop n) (cons a (cdr l)) (cons (car l) (LM:SubstNth a (1- n) (cdr l))) ) ) ) (setq acount 0) (while (< acount (length alist)) (if (= (TYPE (nth acount alist)) 'LIST) (setq mylist (LM:SubstNth (checklist (nth acount alist) mysearchterm myreplace ) acount alist)) (progn ;;if not list (if ( = (nth acount alist) mysearchterm) (setq mylist (LM:SubstNth myreplace acount alist)) ) ; end if ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ; end while mylist ) (princ "My Old List: ") (princ mylist) (princ ". Subs: ") (princ mysearchterm) (princ ". New Item: ") (princ myreplace) (setq Newlist (checklist mylist mysearchterm myreplace)) (princ " : My New List: ") (princ Newlist) (princ) )

Same here.

@Samr1979

This has been asked many times over ... HERE is a function you can use. Do you know how to get points from a polyline?

Differences between ByLayer vs ByBlock: https://www.cad-notes.com/layer-0-bylayer-and-byblock/ I generally set all entity properties in blocks to ByBlock on layer 0 so display insertions of those blocks can be controlled by drawing properties.

If layer isn't there before command is run it will be created but with default settings. This will then change the layer to the correct color from your list. this is prob the best option with all block entity's color to byblock. the second lisp takes part of the updblkcl.lsp and changes entity's color in the block. ;entmod layer change color (defun c:BLKSCALE (/ blklst lst blkname SS ent blk C CBL) (vl-load-com) (setq blklst '(( "BLOCK1" "LAYER1" 250 250 10) ( "BLOCK2" "LAYER2" 500 500 30) ( "BLOCK3" "LAYER3" 150 150 210) ( "BLOCK4" "LAYER4" 100 100 170) ) ) (foreach lst blklst (setq blkname (car lst) lst (cdr lst)) (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname)))) (progn (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car lst) (cadr lst) (caddr lst) 1))) ) ) (setq lay (entget (tblobjname "LAYER" (car lst)))) (entmod (subst (cons 62 (last lst)) (assoc 62 lay) lay)) ) ) ) (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) (princ) ) ;endmod block change color (defun c:BLKSCALE (/ blklst lst blkname SS ent blk C CBL) (vl-load-com) (setq blklst '(( "BLOCK1" "LAYER1" 250 250 10) ( "BLOCK2" "LAYER2" 500 500 30) ( "BLOCK3" "LAYER3" 150 150 210) ( "BLOCK4" "LAYER4" 100 100 170) ) ) (foreach lst blklst (setq blkname (car lst) lst (cdr lst)) (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname)))) (progn (foreach blk (mapcar 'cadr (ssnamex ss)) (entmod (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car lst) (cadr lst) (caddr lst) 1))) ) ) (setq C (last lst)) (setq CBL (tblsearch "BLOCK" (cdr (assoc 2 (entget blk)))))) (setq CBL2 (cdr (assoc -2 CBL))) (while (boundp 'CBL2) (setq EE (entget CBL2)) (setq NCL (cons 62 C)) (setq ACL (assoc 62 EE)) (if (= ACL nil) (setq NEWE (append EE (list NCL))) (setq NEWE (subst NCL ACL EE)) ) ;if (entmod NEWE) (setq CBL2 (entnext CBL2)) ) ;end while ) ) ) (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) (princ) )

I am trying to understand what you do, anyway its working like I need, thank you all for the help!

how about this cad object to dcl code converter https://www.theswamp.org/index.php?topic=20878.msg255063 use png or bmp to dxf converter then edit to looks better then use this

I am trying make a scheme with parent and child Do you have a better solution?

Its not that simple to change the color of a Block. You have to change each sub entity I suggest changing them to bylayer (256) then setting the layer color to what you want. That way it changes automatically. updated this lisp to use acad_colordlg ;**************************************************************************************** ; UPDATE BLOCK COLOR (updblkcl.lsp) ; PRE-INSERTED BLOCK DEFINITION CLEAN-UP UTILITY ; ; This routine is especially usefull to redefine pre-inserted blocks whose ; entity colors need to be changed to BYLAYER. ; ; This routine allows the user to update the color of all entities within ; a block to a single color (exam: color=BYLAYER) without the user ; having to explode the symbol. By default the layer name of ; all entities are NOT changed. The routine changes the original ; definition of the block within the current drawing. ; ; To use this routine the user is asked to specify a single ; color to place all entities of a selected block(s). ; ; The user is next prompted to select one or more blocks to update. The routine ; then redefines all entities of the block to the color specified. ; ; When the user regenerates the drawing she/he will find that all ; occurances of the block have been redefined. This is because the ; original definition of the block is changed!!! ; ; by CAREN LINDSEY, July 1996 ;**************************************************************************************** ; ;INTERNAL ERROR HANDLER (defun err-ubc (s) ; If an error (such as CTRL-C) occurs (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (setq *error* olderr) ; Restore old *error* handler (princ) ) ;err-ubc (DEFUN C:BBL (/ BLK CBL CBL2 C ACL ALY NLY NCL) (vl-load-com) (setq olderr *error* *error* err-ubc) (setq C (acad_colordlg 0)) (prompt "\nPick blocks to update. ") (setq SS (ssget '((0 . "INSERT")))) (setq K 0) (while (< K (sslength SS)) (setq CBL (tblsearch "BLOCK" (cdr (assoc 2 (entget (setq BLK (ssname SS K))))))) (setq CBL2 (cdr (assoc -2 CBL))) (while (boundp 'CBL2) (setq EE (entget CBL2)) (setq NCL (cons 62 C)) (setq ACL (assoc 62 EE)) (if (= ACL nil) (setq NEWE (append EE (list NCL))) (setq NEWE (subst NCL ACL EE)) ) ;if (entmod NEWE) (setq CBL2 (entnext CBL2)) ) ;end while (entupd BLK) (setq K (1+ K)) ) ;end while (setq *error* olderr) (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) (princ) )

HEHE locking viewports is a good habit to get in to. Especially if you have other coworkers on a design team muddling around in your cad files. A couple clicks and your viewports can get absolutely jacked on accident lol. -ChriS