jim78b Posted May 17, 2019 Share Posted May 17, 2019 (edited) i need please a lisp that change nested block : color and linetype to byblock i have one but not always works in nested blocks i attach an example where you can try to edit in place block load bb.lsp and select the block:VIBRAT PIANTA 6 mq the linetype not change in by block even the color nested block.dwg Edited May 17, 2019 by jim78b explain more Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 17, 2019 Author Share Posted May 17, 2019 my lisp is: (defun C:BB () (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) grublo (ssget '((0 . "INSERT"))) ssgetblocks '() ssgetblocks1 '() ) (repeat (setq index(sslength grublo)) (setq ssgetblocks (cons (vla-get-EffectiveName (vlax-ename->vla-object (ssname grublo (setq index(1- index))))) ssgetblocks)) ) (foreach elem ssgetblocks (if (not(member elem ssgetblocks1)) (setq ssgetblocks1 (cons elem ssgetblocks1)) ) ) (foreach elem ssgetblocks1 (setq bloccovl(vla-item blocks elem) index 0 ) (repeat (vla-get-Count bloccovl) (vla-put-Color (vla-item bloccovl index) 0) (vla-put-Linetype (vla-item bloccovl index) "Byblock") (setq index (1+ index)) ) ) (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted May 17, 2019 Share Posted May 17, 2019 Try this: (defun c:foo (/ d) ;; RJP » 2019-05-17 ;; All blocks to color by block (vlax-for a (vla-get-blocks (setq d (vla-get-activedocument (vlax-get-acad-object)))) (if (= 0 (vlax-get a 'islayout)) (vlax-for b a (foreach p '(color linetype) (vl-catch-all-apply 'vlax-put (list b p 0)))) ) ) (vla-regen d acallviewports) (princ) ) (vl-load-com) Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 17, 2019 Author Share Posted May 17, 2019 sorry but the lisp that you posted is not what i mean, i want select block or more one block at a time and set linetype and color byblock Quote Link to comment Share on other sites More sharing options...
ronjonp Posted May 17, 2019 Share Posted May 17, 2019 4 hours ago, jim78b said: sorry but the lisp that you posted is not what i mean, i want select block or more one block at a time and set linetype and color byblock Not sure what is up with that block but this kludge works: (defun c:foo ( / d l ) (cond ((setq l (mapcar '(lambda (x) (cdr (assoc 2 (entget x)))) (cadddr (nentsel "\nPick a nested block: ")) ) ) (vlax-for a (vla-get-blocks (setq d (vla-get-activedocument (vlax-get-acad-object)))) (if (vl-position (vla-get-name a) l) (vlax-for b a (foreach p '(color linetype) (vl-catch-all-apply 'vlax-put (list b p 0)))) ) ) (vla-regen d acallviewports) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 18, 2019 Author Share Posted May 18, 2019 SORRY but this lisp is not what i want, as i explained before i want a lisp that change color and linetype to byblock with multiselection Quote Link to comment Share on other sites More sharing options...
ronjonp Posted May 18, 2019 Share Posted May 18, 2019 1 hour ago, jim78b said: SORRY but this lisp is not what i want, as i explained before i want a lisp that change color and linetype to byblock with multiselection SORRY, but have you searched for this? .. I'm sure it has been answered many times over. The Swamp Cadtutor Autodesk Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 18, 2019 Author Share Posted May 18, 2019 (edited) See mi first post...i nerd ti chance color and linetype to byblock .in nested block and can select more than one block in a Drawing, i think is clear...or sorry for bad explanation Edited May 18, 2019 by jim78b Quote Link to comment Share on other sites More sharing options...
Mara821 Posted May 18, 2019 Share Posted May 18, 2019 Hi, try this one (vl-load-com) (defun c:byBlock (/ col cnt lop sel) ;;;--------------------------------------------------------------------------------------------------------------------- ;;; subroutines ;; remove duplicated items in list (defun LM:unique (l) ; by Lee Mac (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))) ;; set "by block" to all entities in block definition (defun BB:setByBlock (nam / blc blk) (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq blk (vla-item blc nam)) (vlax-for x blk (vla-put-layer x "0") (vla-put-color x acByBlock) (vla-put-linetype x "ByBlock") (vla-put-linetypescale x 1.0) (vla-put-lineweight x acLnWtByBlock) (vla-put-entityTransparency x "ByBlock:") (vla-put-material x "ByBlock") (if (eq (vla-get-objectName x) "AcDbBlockReference") (BB:setByBlock (vla-get-effectiveName x)))) ) ;;;--------------------------------------------------------------------------------------------------------------------- ;;; main (setq lop t) (while lop (princ "\nSelect blocks: ") (if (setq sel (ssget '((0 . "INSERT")))) (progn (setq cnt 0) (setq col nil) (repeat (sslength sel) (setq obx (vlax-ename->vla-object (ssname sel cnt))) (setq col (cons (vla-get-effectiveName obx) col)) (setq cnt (1+ cnt))) (setq col (LM:unique col)) (foreach x col (BB:setByBlock x)) (setq lop nil)) (princ "\nNo selection"))) (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport) (princ)) Dynamic blocks don't update and I dont know why. Vla-update doesnť work. Vla-resetBlock works but all dynamic parametres are lost. 1 Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 19, 2019 Author Share Posted May 19, 2019 thanks MAra821 you are the best really! it is work fine! good day !! best regards Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 19, 2019 Author Share Posted May 19, 2019 CONSIDERING THAT YOU ARE SO GOOD I MIGHT PLEASE CHANGE THIS LISTED? the command rotates and copies once, I want it to rotate and copy x times as in the command copy of autocad is possible? (defun C:RTC (/ gru) (setq gru (ssget)) (if gru (progn (command "_COPY" gru "" (list 0 0)(list 0 0)) (command "_ROTATE" "_P" "") (princ "\nBase point e primo punto d'angolo: ") (command pause "_R") (command (getvar "LASTPOINT")) (princ "\nSecondo punto d'angolo: ") (command pause) (princ "\nAngolo finale: ") (command pause) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Mara821 Posted May 19, 2019 Share Posted May 19, 2019 Something like this? (defun C:RTC (/ *error* gru lop ptb) (defun *error* (msg /) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (vl-exit-with-error (princ (strcat "\nError: " msg)))) (princ)) (setq gru (ssget)) (if gru (progn (setq lop t) (while lop (initget "Exit") (setq ptb (cond ((getpoint "\nBase point e primo punto d'angolo or [Exit] <Exit>: ")) ("Exit"))) (if (eq ptb "Exit") (setq lop nil) (progn (command "_COPY" gru "" (list 0 0) (list 0 0)) (command "_ROTATE" "_L" "" ptb) (command "_R") (command (getvar "LASTPOINT")) (princ "\nSecondo punto d'angolo: ") (command pause) (princ "\nAngolo finale: ") (command pause)))))) (princ)) You have to define base point and reference angle with every copy. Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 19, 2019 Author Share Posted May 19, 2019 I want define reference angle and base point only 1 time Quote Link to comment Share on other sites More sharing options...
Mara821 Posted May 21, 2019 Share Posted May 21, 2019 I can't do with the preview so at least like this (defun C:RTC (/ *error* gru lop ptb ptr pti) (defun *error* (msg /) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (vl-exit-with-error (princ (strcat "\nError: " msg)))) (princ)) (setq gru (ssget)) (if gru (progn (setq ptb (getpoint "\nBase point e primo punto d'angolo: ")) (setq ptr (getpoint "\nSecondo punto d'angolo: ")) (setq lop t) (while lop (initget "Exit") (setq pti (cond ((getpoint "\nAngolo finale: or [Exit] <Exit>: ")) ("Exit"))) (if (eq pti "Exit") (setq lop nil) (progn (command "_ROTATE" gru "" ptb "_C" "_R" ptb ptr pti)))))) (princ)) Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 22, 2019 Author Share Posted May 22, 2019 thanks but don't work as i thought , if you can try the command copy ...i want like that, you can copy x times and then stop when you want ...so the command rtc Quote Link to comment Share on other sites More sharing options...
myloveflyer Posted May 22, 2019 Share Posted May 22, 2019 (defun c:Change_Col (/ i ent sel obj lst LayLst) (setq *App (vlax-get-acad-object)) (setq *Doc (vla-get-ActiveDocument *APP)) (setq *BLK (vla-get-blocks *DoC)) (setq i 0) (setq LayLst (Get_Layer_Status *Doc)) (UnLock_All_Layers *DOC) (UnFreeze_All_Layers *DOC) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (sslength sel) (setq ent (ssname sel i)) (setq obj (vlax-ename->vla-object ent)) (setq lst (entget ent)) (change-color obj) (setq i (1+ i)) ) (princ "\nNo choice of objects!") ) (Restore_Layer_Status LayLst) (princ) ) (defun change-color (obj / name blks) (vla-put-color obj AcByLayer) (if (or (= (vla-get-objectname obj) "AcDbBlockReference") (= (vla-get-objectname obj) "AcDbMInsertBlock") ) (progn (foreach Att (vlax-invoke Obj 'GetAttributes) (vla-put-layer Att "0") (vla-put-Color Att AcByLayer) ) (setq name (vla-get-name obj)) (setq blks (vla-item *BLK name)) (vlax-for n blks (change-color n) ) ) (vla-put-layer obj "0") ) ) (defun Get_Layer_Status (*DOC / V_LIST L_LIST C_LIST T_LIST W_LIST) (vlax-for n (vla-get-layers *DOC) (setq V_List (cons (cons n (vla-get-LayerOn n)) V_List) L_List (cons (cons n (vla-get-Lock n)) L_List) C_List (cons (cons n (vla-get-TrueColor n)) C_List) T_List (cons (cons n (vla-get-Linetype n)) T_List) W_List (cons (cons n (vla-get-LineWeight n)) W_List) F_List (cons (cons n (vla-get-Freeze n)) F_List) ) ) (List V_List L_List C_List T_List W_List F_List) ) (defun Restore_Layer_status (LayLst) (mapcar (function (lambda (x y) (foreach n X (if (/= (strcase (setq name (vla-get-name (car n)))) (strcase (getvar "clayer")) ) (vlax-put-property (car n) y (cdr n)) (if (/= y "Freeze") (vlax-put-property (car n) y (cdr n)) ) ) ) ) ) LayLst (list "Layeron" "Lock" "TrueColor" "LineType" "LineWeight" "Freeze") ) ) (defun UnLock_All_Layers (*DOC) (vlax-for n (vla-get-layers *DOC) (vla-put-lock n :vlax-false) ) ) (defun UnFreeze_All_Layers (*DOC) (vlax-for n (vla-get-layers *DOC) (if (/= (strcase (vla-get-name n)) (strcase (getvar "clayer")) ) (vla-put-Freeze n :vlax-false) ) ) ) This program will transfer all the graphics to the 0 layer, because only the 0 layer object color will change, other layers may not be able to change, I hope to help you. Quote Link to comment Share on other sites More sharing options...
myloveflyer Posted May 22, 2019 Share Posted May 22, 2019 This Code is from Gilles Chanteau and maybe he will have a newer version. Edit_bloc_3.0_eng.dcl Edit_bloc_3.0_eng.lsp 1 Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 22, 2019 Author Share Posted May 22, 2019 OK THANKS Quote Link to comment Share on other sites More sharing options...
jim78b Posted May 31, 2019 Author Share Posted May 31, 2019 EXCUSE ME BUT RTC.LSP DON'T WORK AS I THOUGHT i want set at start the reference point angle and then copy as many times as I want 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.