[编程交流] 动态块和脚本

;SORCED [url]http://forums.augi.com/archive/index.php/t-31578.html[/url]
;17/11/2011
;posted by irneb ;at 2007-12-07, 01:11 PM ;on [url]http://forums.augi.com/archive/index.php/t-31578.html[/url]
;modified RCondon 17/11/2011
(defun c:DBSS (/ name ss namelist n en ed eo sslist)
;; Ask user for block's effective name
(if (not (setq name (getstring "Enter the block's effective name: ")))
(quit)
) ;_ end of if
;; Search through blocks for anonymous referring to this effective name
(setq namelist (list name) ;Initialize names list with normal block's name
ss (ssget "x" '((0 . "INSERT") (2 . "`**"))) ;Get all anonymous blocks in drawing
n 0 ;Initialize counter
) ;_ end of setq
;; Step through selection set
(while (< n (sslength ss))
;; Get nth entity in selection set + it's data
(setq en (ssname ss n)
ed (entget en)
) ;_ end of setq
;; Check if it isn't an unchanged dynamic block & that it hasn't been added to the list already
(if (and
(/= name (cdr (assoc 2 ed)))
(not (member (strcat "`" (cdr (assoc 2 ed))) namelist))
) ;_ end of and
(progn
;; Get the entity's object handle
(setq eo (vlax-ename->vla-object en))
;; Check if effective name is the same
(if (= name (vlax-get-property eo 'EffectiveName))
;; Add the anonymous block's name with reverse appostrophe prefix
(setq namelist (cons (strcat "`" (cdr (assoc 2 ed))) namelist))
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(setq n (1+ n))
) ;_ end of while
;; Clear selection set & clear memory
(setq ss nil)
(gc)
;; Construct the selection filter list in reverse order
(setq sslist '((-4 . "<OR") (0 . "INSERT"))
n 0
) ;_ end of setq
;; Step through the list of names
(while (< n (length namelist))
;; Add the name to the filter list
(setq sslist (cons (vl-list* 2 (nth n namelist)) sslist))
(setq n (1+ n))
) ;_ end of while
;; End the filter list's OR section
(setq sslist (cons '(-4 . "OR>") sslist))
;; Reverse the list to get it in the correct order
(setq sslist (reverse sslist))
) ;_ end of defun

(load "DBSS.lsp")
DBSS
TAG_PAV
_.erase P