Jump to content
Designer

Lisp to show the visibility state of dynamic block on leader

Recommended Posts

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

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
Designer

Thanks your the best :)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...