Lisp显示可见性st
大家好，已经有一段时间了。
是否有人使用lisp在引线上显示动态块的可见性状态？
干杯 只需快速剪切粘贴在一起的副本：
; modified / supplemented lsp found on : http://www.cadtutor.net/forum/showthread.php?39301-Block-into-multileader-text/page2&highlight=leader
(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-textstringentl "No visibility") (vla-put-textstringentl 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 谢谢，成功了。
我试着改变你写的行（vla put textstring entl“No visibility”）来显示当没有可见性模式来显示块名时，我试过（vla put textstring entl effectivename），但没有成功。
你能再帮我一次吗？
当然：
; modified lsp found on : http://www.cadtutor.net/forum/showthread.php?39301-Block-into-multileader-text/page2&highlight=leader
(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-textstringentl visname)
(vla-put-textstringentl
(vlax-get-propertyblk
(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 谢谢你的好意
页:
[1]