Lisp to show the visibility state of dynamic block on leader

[Designer]

Hi all,

 

It`s been a while.

 

Does anyone have a lisp to show on a leader the visibility state of a dynamic block?

 

Cheers

[rlx]

Just quickly cut-copy-pasted together :

 

 

; modified / supplemented lsp found on : [url]http://www.cadtutor.net/forum/showthread.php?39301-Block-into-multileader-text/page2&highlight=leader[/url]
(defun c:VisLabel (/ blk entl obj)
 (vl-load-com)
 (cond ((not (setq blk (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget blk))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (and (not (equal entl (setq entl (entlast)))) (setq entl (vlax-ename->vla-object entl)))
           (if (not (setq visname (GetBVis (vlax-ename->vla-object blk))))
             (vla-put-textstring  entl "No visibility")   (vla-put-textstring  entl visname)
          )
        )
       )
 )
 (princ)
)
; just some ccp (cut copy paste) from my RlxBlk.lsp
; (GetBVis (vlax-ename->vla-object (car (entsel))))
; get current visibility name block object
(defun GetBVis ( %blk / blk dic bvp bvn)
 (if (and (vl-every
     '(lambda (p)(vlax-property-available-p %blk p)) '(isdynamicblock hasextensiondictionary effectivename))
   (setq blk (vla-item (vla-get-blocks (vla-get-document %blk)) (vla-get-effectivename %blk)))
   (setq dic (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK"))
   (setq bvp (findaso "BLOCKVISIBILITYPARAMETER" (massoc 360 dic)))
   (setq bvn (cdr (assoc 301 bvp))))
   (vl-some '(lambda (p) (if (= (vla-get-PropertyName p) bvn) (vlax-get p 'Value)))
     (vlax-invoke %blk 'getDynamicBlockProperties))))
(defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l))
(defun FindAso ($v %l) (vl-some (function (lambda(x) (if (= $v (cdr (assoc 0 (setq e (entget x))))) e nil))) %l))

gr.Rlx

[Designer]

Thank you it worked.

 

I tried to change the line where you put to write (vla-put-textstring entl "No visibility") to show when there is no visibility mode to show the block name, i tried (vla-put-textstring entl effectivename) but it didn't work.

Can you help me again?

 

Just quickly cut-copy-pasted together :

 

 

; modified / supplemented lsp found on : [url]http://www.cadtutor.net/forum/showthread.php?39301-Block-into-multileader-text/page2&highlight=leader[/url]
(defun c:VisLabel (/ blk entl obj)
 (vl-load-com)
 (cond ((not (setq blk (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget blk))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (and (not (equal entl (setq entl (entlast)))) (setq entl (vlax-ename->vla-object entl)))
           (if (not (setq visname (GetBVis (vlax-ename->vla-object blk))))
             (vla-put-textstring  entl "No visibility")   (vla-put-textstring  entl visname)
          )
        )
       )
 )
 (princ)
)
; just some ccp (cut copy paste) from my RlxBlk.lsp
; (GetBVis (vlax-ename->vla-object (car (entsel))))
; get current visibility name block object
(defun GetBVis ( %blk / blk dic bvp bvn)
 (if (and (vl-every
     '(lambda (p)(vlax-property-available-p %blk p)) '(isdynamicblock hasextensiondictionary effectivename))
   (setq blk (vla-item (vla-get-blocks (vla-get-document %blk)) (vla-get-effectivename %blk)))
   (setq dic (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK"))
   (setq bvp (findaso "BLOCKVISIBILITYPARAMETER" (massoc 360 dic)))
   (setq bvn (cdr (assoc 301 bvp))))
   (vl-some '(lambda (p) (if (= (vla-get-PropertyName p) bvn) (vlax-get p 'Value)))
     (vlax-invoke %blk 'getDynamicBlockProperties))))
(defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l))
(defun FindAso ($v %l) (vl-some (function (lambda(x) (if (= $v (cdr (assoc 0 (setq e (entget x))))) e nil))) %l))

gr.Rlx

[rlx]

sure :

 

 

; modified lsp found on : [url]http://www.cadtutor.net/forum/showthread.php?39301-Block-into-multileader-text/page2&highlight=leader[/url]
(defun c:VisLabel (/ blk entl pt visname)
 (cond ((not (setq blk (car (entsel "\nSelect block: ")))))
       ((not (eq (cdr (assoc 0 (entget blk))) "INSERT")) (princ "\nInvalid object!"))
       ((setq pt (getpoint "\nSpecify first point: "))
        (setq entl (entlast) blk (vlax-ename->vla-object blk))
        (vl-cmdf "_.mleader" "_non" pt "\\")
        (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
        (if (and (not (equal entl (setq entl (entlast)))) (setq entl (vlax-ename->vla-object entl)))
   (if (setq visname (GetBVis blk))
     (vla-put-textstring  entl visname)
     (vla-put-textstring  entl
       (vlax-get-property  blk
  (if (vlax-property-available-p blk 'EffectiveName) 'EffectiveName 'Name))))))
 )
 (princ)
)

; just some ccp (cut copy paste) from my RlxBlk.lsp
; (GetBVis (vlax-ename->vla-object (car (entsel))))
; get current visibility name block object
(defun GetBVis ( %blk / blk dic bvp bvn)
 (if (and (vl-every '(lambda (p)(vlax-property-available-p %blk p)) '(isdynamicblock hasextensiondictionary effectivename))
   (setq blk (vla-item (vla-get-blocks (vla-get-document %blk)) (vla-get-effectivename %blk)))
   (setq dic (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK"))
   (setq bvp (findaso "BLOCKVISIBILITYPARAMETER" (massoc 360 dic)))
   (setq bvn (cdr (assoc 301 bvp))))
   (vl-some '(lambda (p) (if (= (vla-get-PropertyName p) bvn) (vlax-get p 'Value)))
     (vlax-invoke %blk 'getDynamicBlockProperties))))
(defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l))
(defun FindAso ($v %l) (vl-some (function (lambda(x) (if (= $v (cdr (assoc 0 (setq e (entget x))))) e nil))) %l))

 

 

gr.Rlx

[Designer]

Thanks your the best