Leaderboard

Update line 38 (setq ss_txtlines (ssget "x" '((0 . "*TEXT")))) also might want to look at this. http://www.lee-mac.com/bfind.html

Rather than modifying the drawing why not just control the layers displayed in the Layer Properties Manager with Layer Filters? Check out this link: https://cadtips.cadalyst.com/layer-tools/create-filter-all-layers-except-xref-layer?q=layer-tools/create-filter-all-layers-except-xref-layer Our Civil 3D template has around 200 layers by itself so I load a collection of Layer Filters using this lisp to control the visible layers for whatever workflow I'm using at the time. ; (load "LayFilterAdd.lsp") ; ^C^C^P(or LayFilterAdd (load "LayFilterAdd.lsp"));(LayFilterAdd) ; Newer versions automatically display Xref Layer Filters **Adding Xref Layer Filter names the same as them can cause serious issues** ; Save, close and reopen the DWT or DWG for the Filters to be put into alphabetical order. (defun LayFilterAdd (/ collection names) ; (load "LFD.lsp") ; (command "C:LFD" "All*") *Layers (setq names (list "")) (if (not (vl-catch-all-error-p (setq collection (vl-catch-all-apply (function (lambda () (vla-item (vla-getextensiondictionary (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) "ACAD_LAYERFILTERS"))) )))) ; (vlax-for item collection (setq names (cons (strcase (vla-get-name item)) names)))) (vlax-for item collection (setq names (cons (vla-get-name item) names)))) names (or(member "CALC Points" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"V-NODE-CALC\" or NAME== \"Layer*\"" "CALC Points" "X" nil)) (or(member "HATCH No xrefs" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~*|*\" and NAME==\"*HATCH\"" "HATCH No xrefs" "X" nil)) (or(member "Linetype" names)(command "._-layer" "filter" "new" "property" "All" "LINETYPE==\"~Continuous\"" "Linetype" "X" nil)) (or(member "Lineweight" names)(command "._-layer" "filter" "new" "property" "All" "LINEWEIGHT==\"~Default\"" "Lineweight" "X" nil)) (or(member "NCS" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"[A,C,E,L,V]-*\" or NAME== \"Layer*\"" "NCS" "X" nil)) (or(member "NCS No xrefs" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~*|*\" and NAME==\"[A,C,E,L,V]-*\" or NAME== \"Layer*\"" "NCS No xrefs" "X" nil)) (or(member "No NCS" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~[A,C,E,L,V]-*\"" "No NCS" "X" nil)) (or(member "No NCS or xrefs" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~*|*\" and NAME==\"~[A,C,E,L,V]-*\"" "No NCS or xrefs" "X" nil)) (or(member "No NODE" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~*|*\" and NAME==\"[A,C,E,L,V]-*\" and NAME==\"~*-NODE*\" or NAME== \"Layer*\"" "No NODE" "X" nil)) (or(member "NODE" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"~*|*\" and NAME==\"[A,C,E,L,V]-*\" and NAME==\"*-NODE*\" or NAME== \"Layer*\"" "NODE" "X" nil)) (or(member "Profile" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"C-ROAD-PROF*\" or NAME== \"Layer*\"" "Profile" "X" nil)) (or(member "Sections" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"C-ROAD-SEC*\" or NAME== \"Layer*\"" "Sections" "X" nil)) (or(member "Topo" names)(command "._-layer" "filter" "new" "property" "All" "NAME==\"C-TOPO*\" or NAME== \"Layer*\"" "Topo" "X" nil)) (princ "Layer Filter Names » ")(princ names) ; (princ "\nSave, close and reopen the DWT or DWG for the Filters to be put into alphabetical order.") (princ) ); function (LayFilterAdd) Quick, simple & easily manageable.

Try this ; https://www.cadtutor.net/forum/topic/73977-set-selected-objects-color-to-their-current-index-color/ ; MAKE 1 LAYER BUT SAVE COLOR ; By Alanh NOV 2021 (defun c:make1lay ( / laynew layers layn ss x obj col) (setq laynew (getstring "\nEnter new layer name ")) (command "-la" "M" laynew "") (command "UNDO" "M") (vlax-for layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq col (vla-get-color layers)) (setq layn (vla-get-name layers)) (if (= layn laynew) (princ) (progn (setq ss (ssget "X" (list (cons 8 layn)))) (if (= ss nil) (princ (strcat "\nskip " layn)) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (if (vlax-property-available-p obj 'layer) (vlax-put-property obj 'Layer laynew) ) (if (vlax-property-available-p obj 'color) (vlax-put-property obj 'color col) ) ) ) ) ) ) ) (c:make1lay)

I remember the days of 640x480 resolution went to 1024x760 WOW, with 4k now these sort of things are creeping in.

I think I have fixed it. It was selecting the last used viewport to calculate the angel, north, and scale. Before you update the lisp run one last test on my drawing to see what I am talking about. go to tab SK (2) and activate the viewport. pan, zoom, make changes to the viewport some how. go back to paper space and switch to SK Activate the viewport in SK and use MS2PS. It will import the entiys from model space using SK (2) Update line 55 (setq enx (entget (ssname (ssget "_X" (list '(0 . "VIEWPORT") (cons 69 (getvar 'cvport))(cons 410 (getvar 'ctab)))) 0)) This will select the correct Viewport to run the calculations on. TESTv3_ms2ps.dwg

An extra bug ^c^c^ is wrong cancel cancel does not need the last ^ ^c^c is correct this may have been causing early errors ^c^c^p is often used also.

@BIGAL @Dadgad I would go with the LAYMRG command that Dadgad mentioned, it could be turned into a macro if it is always a list of the same layers that are involved, but just as a command it does only require picking two objects, one on the original layer and then an object on the destination layer (or choose the option NAME to pick from a dialogue box). The -LAYMRG version og the command will also delete the original layer if that is required.

You dont have to do it that way can just loop trough the toggle buttons as you know they are t+number. Simplest way is look at these programs, Multi Radio Buttons, Multi Getvals and Multi toggles are in the download section here at cadtutor. Yes the Multi Toggles makes a single list (0 1 0 1 1 1 0 1 0 1) The bit you want (defun mkv_lst ( / ) (setq v_lst '()) (setq x 1) (repeat (- (length ahbutlst) 1) (setq val (strcat "Tb" (rtos x 2 0))) (setq v_lst (cons (get_tile val) v_lst)) (setq x (+ x 1)) ) ) (setq y 0) (repeat (- (length ahbutlst) 1) (setq keynum (strcat "Tb" (rtos (setq y (+ Y 1)) 2 0))) (set_tile keynum "0") (mode_tile keynum 3) ) (action_tile "accept" "(mkv_lst)(done_dialog)")