Jump to content

Lisp to show the visibility state of dynamic block on leader


Designer

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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