[编程交流] Lisp显示可见性st

; 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))

; 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))