Lisp: blinks the layer of the

garlictaste · 发表于 2022-7-6 11:54:44

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 ?

copy

(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 · 发表于 2022-7-6 11:58:42

This should work:

copy

(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 · 发表于 2022-7-6 12:02:01

Another two to try:

copy

(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  : "))))          (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))

copy

(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 ""))))         (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 · 发表于 2022-7-6 12:07:06

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 · 发表于 2022-7-6 12:08:50

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

Lee Mac · 发表于 2022-7-6 12:14:41

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 · 发表于 2022-7-6 12:15:34

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.