Lisp: blinks the layer of the selected entity

[garlictaste]

Hallo,

I found this on cadforum cz

It works fine on acad2010, but not in acad2008.

Is it impossible, or what do I have to change ?

 

(defun C:BLINK ( / ent lay sslay)
(defun ssblik (ss val / ssl i entn)
 (setq i 0  ssl (sslength ss))
 (repeat ssl
    (setq entn (ssname ss i))
    (redraw entn val)
    (setq i (1+ i))
 )
)
(setvar "cmdecho" 0)
(if (and
    (setq ent (entsel "\n select : "))
    (setq ent (car ent))
    (setq lay (cdr (assoc 8 (entget ent))))
    (setq sslay (ssget "_X" (list (cons 8 lay))))
    )
 (repeat 12
    (ssblik sslay 3)
    (command "._delay" "200")
    (ssblik sslay 4)
    (command "._delay" "200")
 ))
(princ)
)
;(regenall)?

 

It is a good tool to find all things on the selected layer.

Greets from - garlic-

[Lee Mac]

This should work:

 

(defun c:blink (/ *error* blinker i ent ss OldCm ObjLst )

 (defun *error* (msg)
   (if oldCm (setvar "CMDECHO" oldCm))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun blinker (lst code / x lst)
   (while (setq x (car lst))
     (redraw x code)
     (setq lst (cdr lst))))

 (if (and (setq i -1 ent (car (entsel "\nSelect Object: ")))
          (setq ss  (ssget "_X" (list (assoc 8 (entget ent))))))
   (progn
     (setq OldCm (getvar "CMDECHO"))
     (setvar "CMDECHO" 0)

     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq ObjLst (cons ent ObjLst)))

     (repeat 12
       (blinker ObjLst 3)
       (command "_.delay" 200)
       (blinker ObjLst 4)
       (command "_.delay" 200))

     (setvar "CMDECHO" OldCm)))

 (princ))

[Lee Mac]

Another two to try:

 

(defun c:hlight  (/ lLst lay i ss ent)
 ;; Lee Mac  ~  08.01.10
 (vl-load-com)

 (setq *acad* (cond (*acad*) ((vlax-get-acad-object)))
       *doc*  (cond (*doc* ) ((vla-get-ActiveDocument *acad*))))

 (vlax-map-collection (vla-get-layers *doc*)
   (function (lambda (x) (setq lLst (cons (strcase (vla-get-name x)) lLst)))))

 (while
   (progn
     (setq lay (strcase
                 (getstring t
                   (strcat "\nSpecify Layer to highlight <" (getvar "CLAYER") "> : "))))
     
     (cond (  (eq "" lay) (not (setq lay (getvar "CLAYER"))))

           (  (not (vl-position lay lLst)) (princ "\n** Layer not Found **")))))

 (if (setq i -1 ss (ssget "_X" (list (cons 8 lay))))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (redraw ent 3)))

 (princ))

(defun c:hlight2  (/ lay ObjLst NulLst grdat iEnt)
 ;; Lee Mac  ~  08.01.10
 
 (princ "\nMove Cursor Over Objects....")  
 (while (eq 5 (car (setq grdat (grread t 4 2))))
   
   (if (setq iEnt (car (nentselp (cadr grdat))))
     (progn
       (setq lay    (cdr (assoc 8 (entget iEnt)))
             ObjLst (mapcar (function cadr)
                            (ssnamex (ssget "_X" (list (cons 8 lay))))))
       (mapcar (function (lambda (x) (redraw x 3))) ObjLst)
       
       (if (setq nss (ssget "_X" (list (cons -4 "<NOT") (cons 8 lay)
                                       (cons -4 "NOT>"))))
         (progn
           (setq NulLst (mapcar (function cadr) (ssnamex nss)))
           (mapcar (function (lambda (x) (redraw x 2))) NulLst))))
     
     (progn
       (and ObjLst (mapcar (function (lambda (x) (redraw x 4))) ObjLst))
       (and NulLst (mapcar (function (lambda (x) (redraw x 1))) NulLst)))))
 
 (princ))

[wizman]

I've seen this Blink lisp before but not working in '09 also the blink version by lee is not ok in '09. but in '10 both are ok.

[lpseifert]

That's odd, both versions of Blink.lsp worked for me in '09.

[Lee Mac]

I've seen this Blink lisp before but not working in '09 also the blink version by lee is not ok in '09. but in '10 both are ok.

 

Do the other two work Wiz? What error do you receive in '09 - I assume its something to do with the Delay command. :wink:

[wizman]

oops, i deleted my post, i hope you got my message that adjusting delay doesn't do also, the other two were fine, let's wait for the test on '08 version.

[wizman]

i forgot i got '08 also here, both doesn't blink also.

[stevesfr]

oops, i deleted my post, i hope you got my message that adjusting delay doesn't do also, the other two were fine, let's wait for the test on '08 version.

 

Guys, blink did not work here in AC8. hlight & hlight2 work fine in AC8 here. hlight2 is neat for me.

HTH

[Lee Mac]

hlight2 is neat for me.

 

...HTH ...

[garlictaste]

"blink" and "hlight2" works fine here in acad2008 and 2010

 

That`s it! Thanks a lot:)

[TimSpangler]

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 differing colors. 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

[stevesfr]

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 differing colors. 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)

 

Cool!!!!!!!!!

[garlictaste]

:cry:mhhhhhhhh, here it does not work in 2008 and 2010, Tim:

 

Program Error: BAD ARGUMENT TYPE: STREAMP NIL

 

Did I something wrong?

 

-garlic-

[Lee Mac]

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?

[wizman]

Man, I wrote something like this about 10 years ago. ..

 

Thanks Tim, Wonder if i will still be lisping 10 years from now.....'-)

[TimSpangler]

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)

[garlictaste]

Tim: I got it ! Thanks a lot - it`s very good in acad 2008 and 2010 !

- garlic-

[Lee Mac]

hlight2 is neat for me.

 

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 "<NOT") (cons 8 lay)
                                       (cons -4 "NOT>"))))
         (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))