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

Lisp: blinks the layer of the

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 0ssl (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:
 

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

(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))
(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.

wizman 发表于 2022-7-6 12:19:38

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

stevesfr 发表于 2022-7-6 12:22:24

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

Lee Mac 发表于 2022-7-6 12:27:39

 
...HTH ...
页: [1] 2
查看完整版本: Lisp: blinks the layer of the