[求助]：如何用VLISP遍历块中的各个属性

hqd9639

如题

LUCAS

2. 
   
3. ;;By (LUCAS)龙龙仔
   
4. ;;修改BLOCK REF所有属性性质
   
5. ;;USAGE: (CHANGE_ATTT "LAYER" "DIM")
   
6. ;;USAGE: (CHANGE_ATTT <性质> <值>)
   
7. (defun CHANGE_ATTT (PROPERTY VALUE / BLK BLKREF ENT)
   
8.   (vl-load-com)
   
9.   (while
   
10.     (or        (not (setq BLK (car (entsel "\n选取带属性图块: "))))
    
11.         (progn
    
12.           (setq BLKREF (vlax-ename->vla-object BLK))
    
13.           (not (= (vla-get-objectname BLKREF) "AcDbBlockReference"))
    
14.         )
    
15.     )
    
16.   )
    
17.   (foreach ENT (vlax-safearray->list
    
18.                  (vlax-variant-value (vla-getattributes BLKREF))
    
19.                )
    
20.     ((eval (read (strcat "vla-put-" PROPERTY))) ENT LNAME)
    
21.   )
    
22.   (princ)
    
23. )
    

<br /> ;;By (LUCAS)龙龙仔 <br /> ;;修改BLOCK REF所有属性性质 <br /> ;;USAGE: (CHANGE_ATTT "LAYER" "DIM")<br /> ;;USAGE: (CHANGE_ATTT <性质> <值>)<br /> (defun CHANGE_ATTT (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 />     ((eval (read (strcat "vla-put-" PROPERTY))) ENT LNAME)<br />   )<br />   (princ)<br /> )<br />

snsj

最初由 hqd9639 发布
[B]如题 [/B]

(setq bl (tblnext "block" t))
(setq a nil)
(while
(setq b (tblnext "block"))
(setq a (cons b a))
)
(cons bl a)

hqd9639

最初由 snsj 发布
[B]
(setq bl (tblnext "block" t))
(setq a nil)
(while
(setq b (tblnext "block"))
(setq a (cons b a))
)
(cons bl a) [/B]

斑主，如直接用LISP，应该是这样：

  (while (= (setq e (car (entsel "\nSelect an attributed block: "))) nil))
  (setq e-inf (entget e))
  (if (= (cdr (assoc 0 e-inf)) "INSERT")
    (progn
      (while (/= (setq e (entnext e)) nil)
        (setq e-inf (entget e))
        (if (= (cdr (assoc 0 e-inf)) "ATTRIB")
          (progn
            (setq
              e-value (cdr (assoc 1 e-inf))
              e-prompt (cdr (assoc 2 e-inf))
              e-v-type (type e-value)
            )
            (cond ((= e-v-type 'REAL) (setq e-value (rtos e-value (getvar "lunits") (getvar "luprec"))))
                  ((= e-v-type 'INT) (setq e-value (itoa e-value)))
            )
            (princ (strcat "\n" e-prompt ": " e-value))
          )
        )
      )
    )
  )

hqd9639

最初由 LUCAS 发布
[B][CODE]
;;By (LUCAS)龙龙仔
;;修改BLOCK REF所有属性性质
;;USAGE: (CHANGE_ATTT "LAYER" "DIM")
;;USAGE: (CHANGE_ATTT <性质> <值>)
(defun CHANGE_ATTT (PROPERTY VALUE / BLK BLKREF ENT)
  (vl-load-co... [/B]

谢谢你的指点。
   只是美中不足的是程序会把块中每个属性都改为同一个值，这种情况是比较少见的，要修改的属性改为象这样提示会更好点：[Value/Height/Width/Angle/Font/Layer/Color/Exit]

lsj60912

我有高招
实际上还是别人的高招：
到明经cad里找函数ax:GetAttributes
能够返回形如：(("产品图号" "MDW02" <图元名:4007ffa8>)("名称" "低温箱" <图元名:xxxxxx>) .....)