;;利用属性块中的提示选择块 ;;(setq FILTER (JW_ATT "test")) ;;(setq SS (ssget (list (cons 0 "INSERT") (cons 2 FILTER)))) (defun JW_ATT (str / BLK_NA FILTER) ;;By carrot1983 2009-05-18 (setq FILTER "") (vlax-for BLK (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-for X BLK (if (and (= (vla-get-objectname X) "AcDbAttributeDefinition") (wcmatch (vla-get-promptstring X) str ) ;_支持模糊匹配 (setq BLK_NA (vla-get-name BLK)) ) (setq FILTER (strcat "`" BLK_NA "," FILTER)) ;_`匿名块用到 ) ) ) (if (= FILTER "") NIL FILTER ) ) ;有很多这样的块,提示有“标高_1:10”、“标高_1:20”“标高_1:40”“标高_1:50”“标高_1:100”“标高_1:150”“标高_1:200” ;需要批量进行处理 ;下面这个程序可以完成,要搜索图中所有的块,然后才进行判断,文件大一点的话太慢了。 ;请教如何改成:只对所选的块进行判断? (defun C:TT ( / edat edat1 en filter in_sc1 ins ins_e insc n n_in2 scal ss_bg promptstring) (princ "\n把属性块里的(提示)作为过滤条件对图块进行选择 By carrot1983 REV2009-05-19" ) (setq ss (ssget '((0 . "INSERT")))) (SETQ scal 50) (if (/= nil (setq FILTER (JW_ATT (strcat "标高*")))) (progn (vl-cmdf "select" ss "") (setq ss_bg (ssget "p" (list (cons 0 "INSERT") (cons 2 FILTER)))) (repeat (setq n (sslength ss_bg)) (setq edat1 (ssname ss_bg (setq n (1- n))) edat (tblobjname "BLOCK" (cdr (assoc 2 (setq INS_e (entget edat1))))) ) (while (and edat (setq en (entget edat))) (if (= "ATTDEF" (cdr (assoc 0 en))) (setq tag (cdr (assoc 2 en)) promptstring (cdr (assoc 3 en)) ) ) (setq edat (entnext edat)) ) (setq IN_SC1 (atof (substr promptstring (+ (vl-string-position (ascii ":") promptstring) 2))));提取标高_1:后面的数据 (vl-cmdf "_SCALE" edat1 "" "_non" INS (/ scal IN_SC1)) ) ) ) (princ) )
|