[编程交流] 访问自定义ShSet属性t

 ;----------------------------------------------------------- DynamicProps -----
; Function retrieve or set properties from a dynamic block
; (DynamicProps (car (entsel)) "Visibility" nil) get the visibility states from a dynamic block
; (DynamicProps (car (entsel)) "Visibility" "Construction") set the visibility from a dynamic block
; (DynamicProps (car (entsel)) "" nil) get the properties from a dynamic block
; (DynamicProps (car (entsel)) "Pipe length" 2000.0) set the properties from a dynamic block
(defun DynamicProps (ename propname value / obj prpL cla cll prp)
 (setq obj (if (= (type ename) 'VLA-OBJECT) ename (vlax-ename->vla-object ename)))
 (setq prpL (vlax-invoke obj 'getdynamicblockproperties))
 (setq return
   (if (setq prp (vl-remove-if-not (function (lambda(x)(= (vlax-get-property x 'PropertyName) propname))) prpL))
     (mapcar (function (lambda(v)
       (if (and (/= value nil)(vlax-property-available-p v 'Value)(/= (type value)'LIST))
         (progn (vlax-put-property v 'Value value)(vla-update obj))
       )
       (if (and (vlax-property-available-p v 'AllowedValues) (vlax-get v 'AllowedValues))
         (list (vlax-get v 'Value)(vlax-get v 'AllowedValues))
  (vlax-get v 'Value)
       )
     )) prp)
     (mapcar (function (lambda(v)(list (vla-get-propertyName v)(vlax-get v 'Value) v))) prpL)
   )
 )
 return
)
;------------------------------------------------ MWE:GetDBlockNames ------------------
; Function for filtering dynamic blocks
; Arguments: 1
;    arglst = list met names
; Syntax: (MWE:GetDBlockNames '("Issue Stamp")) --> (("ISSUE STAMP" "*U833" "*U841") 
;function by James Allen.
;;; Returns all names used for a dynamic block, including
;;; the actual block name and all anonymous instances.
;;;
;;; (setq names (MWE:GetDBlockNames (list bname)))
;;;
;;; bname = Str - Dynamic block name
;;; names = List - List of all inserted blocks whose
;;; EffectiveName = bname
;;;
;;; (setq names (MWE:GetDBlockNames '("TestDBlock")))
;;; ("TestDBlock" "*U4" "*U5" "*U6")
;;;
;;; James Allen - 26Apr07
;;; Malicoat-Winslow Engineers, P.C.
;;;
;;; Thanks to Joe Burke for pointing out code 331
;;; and to Tony Tanzillo for prodding in that direction.
;;;
(defun MWE:GetDBlockNames (arglst / blk edt enm ins name names)
 (mapcar 'set '(name) arglst)
 (setq names (list name) name (strcase name))
 (vl-load-com)
 (vlax-for blk (vla-get-Blocks (vlax-get (vlax-get-Acad-Object) 'ActiveDocument))
   (if (and (setq enm (tblobjname "block" (vla-get-Name blk)))
     (setq edt (entget enm))
     (= (logand (cdr (assoc 70 edt)) 1) 1))
     (if (and (setq edt (entget (vlax-vla-object->ename blk)))
       (setq enm (cdr (assoc 331 edt)))
       (setq ins (vlax-ename->vla-object enm))
       (eq (vla-get-ObjectName ins) "AcDbBlockReference")
       (wcmatch (strcase (vla-get-EffectiveName ins)) name))
       (setq names (cons (vla-get-Name blk) names))
     )
   )
 )
 (reverse names)
) ;end
;------------------------------------------------ BlockNamesFilter ------------------
;; Argument example: ("TestDBlock" "*U4" "*U5" "*U6")
;; Returns: "TestDBlock,`*U4,`*U5,`*U6,"
(defun BlockNamesFilter (strlst)
 (apply 'strcat (mapcar '(lambda (x)
   (if (wcmatch x "`**,`?*")(strcat "`" x ",")(strcat x ","))) strlst)
 )
)
;----------------------------------------------------------- ChangeVisibility -----
;; Argument example: (ChangeVisibility "Issue Stamp" "Review")
;; Returns: number of changed states
(defun ChangeVisibility (BlkName state / names ss ssl tempEnt)
 (setq names (MWE:GetDBlockNames (list BlkName)))
 (prompt (strcat "\nSelect insert Name " BlkName ": "))
 (if (and (setq ss (ssget (list '(0 . "INSERT")(cons 2 (BlockNamesFilter names)))))
   (> (setq ssl (sslength ss)) 0))
   (progn
     (while (setq tempEnt (ssname ss 0))
(DynamicProps (vlax-ename->vla-object tempEnt) "Visibility" state)
       (ssdel tempEnt ss)
     )
     (princ (strcat "\nChanged "(itoa ssl) " inserts to the visibility <" state ">."))
     ssl
   )
   (princ (strcat "\nInsert " BlkName " not found."))
 )
)
;----------------------------------------------------------- c:ChvConstruction -----
(defun c:ChvConstruction ()
 (ChangeVisibility "Issue Stamp" "Construction")
 (princ)
)
;----------------------------------------------------------- c:ChvReview -----
(defun c:ChvReview ()
 (ChangeVisibility "Issue Stamp" "Review")
 (princ)
)
;----------------------------------------------------------- c:ChvBid -----
(defun c:ChvBid ()
 (ChangeVisibility "Issue Stamp" "Bid")
 (princ)
)
;----------------------------------------------------------- c:ChvReference -----
(defun c:ChvReference ()
 (ChangeVisibility "Issue Stamp" "Reference")
 (princ)
)