[原创]：从块中提取出任一属性的任一组码的值

lsj60912

版主帮忙缩进一下。。。
(defun getatgpcodevalue
                        (blockentname                 atstr
                         gpcode             /                 gpcodevalue
                         atstr_             gpcodels         found
                        )


  (setq gpcodevalue nil)
  (setq found nil)
                                        ;本函数在块中提取出想要的属性所具有的组码的值。传入值为块图元名
  (while (and (/= (cdr (assoc 0 (entget blockentname))) "SEQEND")
              (= found nil)
         )                                ;和想要的属性字符串和组码数值。回传为与组码对应的值。
    (setq blockentname (entnext blockentname))
                                        ;注：传入的属性为字符串，字符串是区分大小写的;
    (setq gpcodels (entget blockentname))
                                        ;调用语法：(getatgpcodevalue blockentname atstr gpcode)
;如(getatgpcodevalue (car (entsel)) "PAGE"  1)
    (setq atstr_ (cdr (assoc 2 gpcodels)))
    (if        (= atstr_ atstr)
      (progn
        (setq gpcodevalue (cdr (assoc gpcode gpcodels)))
        (setq found t)
      )
    )
  )
  gpcodevalue                                )                                        ;如果块中无想要的属性或组码则会返回nil。

心梦相随

顺便问一下，提出该值后，用entmod进行修改该组码好象不能成功啊。有什么好的方法？

LUCAS

2. 
   
3. ;;修改BLOCK REF单一属性性质
   
4. ;;USAGE: (CHANGE_ATT1 "比例" "LAYER" "DIM")
   
5. ;;USAGE: (CHANGE_ATT1 <属性标籤> <性质> <值>)
   
6. (defun CHANGE_ATT1 (TAG PROPERTY VALUE / BLK BLKREF ENT)
   
7.   (vl-load-com)
   
8.   (while
   
9.     (or        (not (setq BLK (car (entsel "\n选取带属性图块: "))))
   
10.         (progn
    
11.           (setq BLKREF (vlax-ename->vla-object BLK))
    
12.           (not (= (vla-get-objectname BLKREF) "AcDbBlockReference"))
    
13.         )
    
14.     )
    
15.   )
    
16.   (foreach ENT (vlax-safearray->list
    
17.                  (vlax-variant-value (vla-getattributes BLKREF))
    
18.                )
    
19.     (if        (= (strcase (vla-get-tagstring ENT)) (strcase TAG))
    
20.       ((eval (read (strcat "vla-put-" PROPERTY))) ENT VALUE)
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )
    
25. 
    
26. ;;提取BLOCK REF单一属性性质
    
27. ;;USAGE: (GET_ATT1 "比例" "LAYER")
    
28. ;;USAGE: (GET_ATT1 <属性标籤> <性质>)
    
29. (defun GET_ATT1        (TAG PROPERTY / VALUE BLK BLKREF ENT)
    
30.   (vl-load-com)
    
31.   (while
    
32.     (or        (not (setq BLK (car (entsel "\n选取带属性图块: "))))
    
33.         (progn
    
34.           (setq BLKREF (vlax-ename->vla-object BLK))
    
35.           (not (= (vla-get-objectname BLKREF) "AcDbBlockReference"))
    
36.         )
    
37.     )
    
38.   )
    
39.   (foreach ENT (vlax-safearray->list
    
40.                  (vlax-variant-value (vla-getattributes BLKREF))
    
41.                )
    
42.     (if        (= (strcase (vla-get-tagstring ENT)) (strcase TAG))
    
43.       (setq VALUE ((eval (read (strcat "vla-get-" PROPERTY))) ENT))
    
44.     )
    
45.   )
    
46.   VALUE
    
47. )
    

<br /> ;;修改BLOCK REF单一属性性质 <br /> ;;USAGE: (CHANGE_ATT1 "比例" "LAYER" "DIM") <br /> ;;USAGE: (CHANGE_ATT1 <属性标籤> <性质> <值>) <br /> (defun CHANGE_ATT1 (TAG PROPERTY VALUE / BLK BLKREF ENT)<br />   (vl-load-com)<br />   (while<br />     (or        (not (setq BLK (car (entsel "\n选取带属性图块: "))))<br />         (progn<br />           (setq BLKREF (vlax-ename->vla-object BLK))<br />           (not (= (vla-get-objectname BLKREF) "AcDbBlockReference"))<br />         )<br />     )<br />   )<br />   (foreach ENT (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes BLKREF))<br />                )<br />     (if        (= (strcase (vla-get-tagstring ENT)) (strcase TAG))<br />       ((eval (read (strcat "vla-put-" PROPERTY))) ENT VALUE)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;提取BLOCK REF单一属性性质 <br /> ;;USAGE: (GET_ATT1 "比例" "LAYER") <br /> ;;USAGE: (GET_ATT1 <属性标籤> <性质>) <br /> (defun GET_ATT1        (TAG PROPERTY / VALUE BLK BLKREF ENT)<br />   (vl-load-com)<br />   (while<br />     (or        (not (setq BLK (car (entsel "\n选取带属性图块: "))))<br />         (progn<br />           (setq BLKREF (vlax-ename->vla-object BLK))<br />           (not (= (vla-get-objectname BLKREF) "AcDbBlockReference"))<br />         )<br />     )<br />   )<br />   (foreach ENT (vlax-safearray->list<br />                  (vlax-variant-value (vla-getattributes BLKREF))<br />                )<br />     (if        (= (strcase (vla-get-tagstring ENT)) (strcase TAG))<br />       (setq VALUE ((eval (read (strcat "vla-get-" PROPERTY))) ENT))<br />     )<br />   )<br />   VALUE<br /> )<br />

lsj60912

调用语法为：(entmod elist)
其中elist是一张表，其格式为与用entget返回的一样，仅组码的值不同。你可以看一下autocad的帮助。