That`s it! Thanks a lot:) Man, I wrote something like this about 10 years ago.I used to work for a company that did a lot of 2d which created a bunch of different layers of differingcolors.in order to find the correct part in all of those layers I wrote this routine to help.
It is old but it does still work.User defined .ini. (change the .ini.lsp to .ini)
LAYER_HL.dcl
LAYER_HL.ini.lsp
LAYER_HL.lsp
Cool!!!!!!!!! :cry:mhhhhhhhh, here it does not work in 2008 and 2010, Tim:
Program Error: BAD ARGUMENT TYPE: STREAMP NIL
Did I something wrong?
-garlic- Did you rename the .ini.lsp file to a .ini ?
Did you change the hard-coded path in the LISP to where you put the .ini file?
Thanks Tim, Wonder if i will still be lisping 10 years from now.....'-)
Funny I haven't used that prog in probably 6-8 years.I just looked at the code....WOW I would write it completely different today.I saw the dat was 2001, the original (non dcl version) was written in 1997, and only blinked one color (green).
Ah the good old days.
-garlic-
You have to open the lisp and change the path to match your path (Sorry) Tim: I got it ! Thanks a lot - it`s very good in acad 2008 and 2010 !
- garlic-
Thought I'd improve it a touch, click to isolate layer
(defun c:hl2 (/ ss->list re-draw CODE ENT GR LAY LLST NSS NULLST OBJLST) (vl-load-com) ;; Lee Mac~08.01.10 (vlax-map-collection (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) (function (lambda (x) (setq llst (cons x llst))))) (defun ss->list (ss / i ent lst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq lst (cons ent lst))) lst) (defun re-draw (lst code) (mapcar (function (lambda (x) (redraw x code))) lst))(princ "\nMove Cursor Over Objects....") (while (and (= 5 (car (setq gr (grread 't 4 2)))) (listp (cadr gr))) (if (setq ent (car (nentselp (cadr gr)))) (progn (setq lay (cdr (assoc 8 (entget ent))) ObjLst (ss->list (ssget "_X" (list (cons 8 lay))))) (re-draw ObjLst 3) (if (setq nss (ssget "_X" (list (cons -4 "")))) (progn (setq NulLst (ss->list nss)) (re-draw NulLst 2)))) (progn (and ObjLst (re-draw ObjLst 4)) (and NulLst (re-draw NulLst 1))))) (and ObjLst (re-draw ObjLst 4)) (and NulLst (re-draw NulLst 1)) (if (listp (cadr gr)) (if (setq ent (car (nentselp (cadr gr)))) (progn (setq lay (strcase (cdr (assoc 8 (entget ent))))) (mapcar (function (lambda (layer) (vla-put-layeron layer (if (eq lay (strcase (vla-get-name layer))) :vlax-true :vlax-false)))) llst)))) (princ))
页:
1
[2]