[编程交流] 需要lisp帮助：删除dy

;;
;;--------- Allen Johnson --------------------------------------------------------
;;
;; find dynamic blocks
;; a command line function to select all dynamic blocks
;; with the same effective name and same visibility state
(defun c:test (/ en obj effname ssdb ssfvis visname visstat c)
(setq en (car (entsel)))
(if en
(progn (setq obj (vlax-ename->vla-object en))
(if (vlax-property-available-p obj 'effectivename)
(progn (setq effname (vlax-get-property obj "effectivename"))
; first create a ss of the dynamic blocks with the right name
(setq ssdb (ssdblk effname))
; now filter for visibility
(setq ssfvis (ssadd)
c 0
)
(setq lookupname "Lookup1")
(setq lookupstat "1")
(while (< c (sslength ssdb))
(setq en (ssname ssdb c))
(setq evstat (print (getdynprop en lookupname)))
;(if (= (strcase evstat) (strcase lookupstat))
(if (= evstat (strcase lookupstat))
(ssadd en ssfvis)
)
(setq c (1+ c))
)
)
(prompt "\nNot a block.\n")
)
(command "erase" ssfvis)
(princ)
)
)
)

(defun c:tst ( / acad doc lay obj)
 (setq acad (vlax-get-acad-object) doc (vla-get-activedocument acad))
 (vlax-for lay (vla-get-layouts doc) (vlax-for obj (vla-get-block lay)
   (and (vl-every '(lambda (p)(vlax-property-available-p obj p)) '(isdynamicblock effectivename))
         (member (vla-get-effectivename obj) '("cabletype A" "cabletype B"))
          (vl-some '(lambda (p) (and (= "Lookup1" (vla-get-propertyname p)) (eq (vlax-get p 'value) "1")))
                     (vlax-invoke obj 'getdynamicblockproperties))  (vla-delete obj)))))