jim78b Posted November 9, 2016 Posted November 9, 2016 I have been searching for a lisp thatchange all selected objects color temporarily ;has anyone seen something that will do that? Quote
ReMark Posted November 9, 2016 Posted November 9, 2016 (edited) Define "temporarily". What action would prompt the color change? What action would reverse the temporary color change? Would the selected objects be blocks? Edited November 9, 2016 by ReMark Quote
jim78b Posted November 9, 2016 Author Posted November 9, 2016 example: I click a button and select the blocks you want to highlight after that if I press escape they to their original color. Quote
jim78b Posted November 9, 2016 Author Posted November 9, 2016 And this is necessary because.........? I must explain a Project To clients. .. Quote
RobDraw Posted November 9, 2016 Posted November 9, 2016 Why do you need code when native AutoCAD has this? Quote
jim78b Posted November 9, 2016 Author Posted November 9, 2016 Thanks You have right! But i have autocad mech 2013 And this function is not avaible . Quote
Lee Mac Posted November 9, 2016 Posted November 9, 2016 Quickly written: (defun c:tempcolor ( / col idx lst obj sel ) (setq col 1) (if (setq sel (ssget "_:L")) (progn (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst (cons (list obj (vla-get-color obj)) lst) ) (vla-put-color obj col) ) (princ "\nPress any key to exit...") (vl-catch-all-apply 'grread) (foreach itm lst (apply 'vla-put-color itm)) ) ) (princ) ) (vl-load-com) (princ) The colour of block components must be set to ByBlock. Quote
RobDraw Posted November 9, 2016 Posted November 9, 2016 Thanks You have right! But i have autocad mech 2013 And this function is not avaible . Dam, bit by the MEP bug again. Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 Ok thanks i Will use It .But i Think i use only One command To do that ...or create a script Who use this lisp routine And change To A color directly It is more fast. Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 you are a genius!!! compliment!!! my initial idea is that all I see is a single color (purple) and clicking on each block is painted a different color. Am I asking too much? Quickly written:(defun c:tempcolor ( / col idx lst obj sel ) (setq col 1) (if (setq sel (ssget "_:L")) (progn (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst (cons (list obj (vla-get-color obj)) lst) ) (vla-put-color obj col) ) (princ "\nPress any key to exit...") (vl-catch-all-apply 'grread) (foreach itm lst (apply 'vla-put-color itm)) ) ) (princ) ) (vl-load-com) (princ) The colour of block components must be set to ByBlock. Quote
Grrr Posted November 10, 2016 Posted November 10, 2016 (edited) you are a genius!!! compliment!!!my initial idea is that all I see is a single color (purple) and clicking on each block is painted a different color. Am I asking too much? What do you mean by PURPLE ? Every object in the selection is changed to RED color. You want the selection to filter for block objects? and change temporarily everyone to different color? BTW Lee, these are geniously written: lst (cons (list obj (vla-get-color obj)) lst) (foreach itm lst (apply 'vla-put-color itm)) If I was attempting I would go with dotted pairs, and mapcar-lambda combo, which would be longer (and perhaps less effective written). And I like that "pause" effect you did: (vl-catch-all-apply 'grread) My way would be with getkword prompt, and error-handler function. Edited November 10, 2016 by Grrr Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 What do you mean by PURPLE ? Every object in the selection is changed to RED color.You want the selection to filter for block objects? and change temporarily everyone to different color? like me10 ...when i open a drawing a see all object , blocks etc in one color (purple) and when i edit a block i see the true color, i am thinking to create a new plot style table... however not crazy to me you've already done a lot. thanks Quote
ReMark Posted November 10, 2016 Posted November 10, 2016 Maybe the selected blocks should blink as well so they really stand out. Quote
Grrr Posted November 10, 2016 Posted November 10, 2016 This would work for selection of blocks: [b][color=BLACK]([/color][/b]defun C:tempcolor [color=#8b4513];| credits to: Lee Mac |; [b][color=FUCHSIA]([/color][/b] / *error* oldcm acDoc SS i o lst [b][color=FUCHSIA])[/color][/b][/color] [b][color=FUCHSIA]([/color][/b]defun *error* [b][color=NAVY]([/color][/b]m[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]and acDoc [b][color=MAROON]([/color][/b]vla-EndUndoMark acDoc[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]command-s [color=#2f4f4f]"_.UNDO"[/color] 1[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]and oldcm [b][color=MAROON]([/color][/b]setvar 'cmdecho oldcm[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]if lst [b][color=MAROON]([/color][/b]foreach x lst [b][color=GREEN]([/color][/b]apply 'vla-put-color x[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]if m [b][color=MAROON]([/color][/b]print m[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]princ[b][color=NAVY])[/color][/b] [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq oldcm [b][color=MAROON]([/color][/b]getvar 'cmdecho[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setvar 'cmdecho 0[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq acDoc [b][color=NAVY]([/color][/b]vla-get-ActiveDocument [b][color=MAROON]([/color][/b]vlax-get-acad-object[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]vla-StartUndoMark acDoc[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nSelect blocks to change their color temporarily: "[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq SS [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"_:L"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]progn [b][color=MAROON]([/color][/b]repeat [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]sslength SS[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq o [b][color=BLUE]([/color][/b]vlax-ename->vla-object [b][color=RED]([/color][/b]ssname SS [b][color=PURPLE]([/color][/b]setq i [b][color=TEAL]([/color][/b]1- i[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq lst [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]list o [b][color=PURPLE]([/color][/b]vla-get-color o[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] lst[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]vla-put-color o [b][color=BLUE]([/color][/b]rem i 256[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vlax-for BlkDef [b][color=GREEN]([/color][/b]vla-get-Blocks acDoc[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]eq [b][color=RED]([/color][/b]vla-get-IsLayout BlkDef[b][color=RED])[/color][/b] :vlax-false[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]vlax-for o BlkDef [b][color=RED]([/color][/b]vla-put-color o 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]getkword [color=#2f4f4f]"\nPress enter/escape to exit..."[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]foreach x lst [b][color=GREEN]([/color][/b]apply 'vla-put-color x[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]vla-EndUndoMark acDoc[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.UNDO"[/color] 1[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]and oldcm [b][color=GREEN]([/color][/b]setvar 'cmdecho oldcm[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b] [b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b] [b][color=BLACK])[/color][/b][color=#8b4513];| defun |; [b][color=BLACK]([/color][/b]or vlax-get-acad-object [b][color=FUCHSIA]([/color][/b]vl-load-com[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b][/color] Make sure to keep LM's name, as I'm not a real programmer and I don't take/steal any credits. Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 you are very kindly, i try the lisp, but i can not understand why sometimes give me a random color? however good lisp thanks! Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 it would be more useful when I select a block the color is activated Quote
Lee Mac Posted November 10, 2016 Posted November 10, 2016 BTW Lee, these are geniously written: lst (cons (list obj (vla-get-color obj)) lst) (foreach itm lst (apply 'vla-put-color itm)) If I was attempting I would go with dotted pairs, and mapcar-lambda combo, which would be longer (and perhaps less effective written). And I like that "pause" effect you did: (vl-catch-all-apply 'grread) My way would be with getkword prompt, and error-handler function. Thank you Grrr An alternative could be to use mapcar with two separate argument lists, i.e.: (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) ls1 (cons obj ls1) ls2 (cons (vla-get-color obj) ls2) ) Then: (mapcar 'vla-put-color ls1 ls2) Quote
jim78b Posted November 10, 2016 Author Posted November 10, 2016 So which is The full code ? What Will happen? Thank you Grrr An alternative could be to use mapcar with two separate argument lists, i.e.: (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) ls1 (cons obj ls1) ls2 (cons (vla-get-color obj) ls2) ) Then: (mapcar 'vla-put-color ls1 ls2) Quote
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.