[求助]：请问如何提取图块的属性值？

似水无痕

我以前的图块有错误，但是属性值都正确，现在想提取该图块的属性后再重新插入正确的图块，然后将各个提取的属性重新赋值给正确的图块后插入，请问用lisp如何解决？

eachy

块是什么错误？和正确块是什么关系？两个块的属性是对应关系吗？

这些问题要说清楚别人才能帮你

似水无痕

噢，我没有表达清楚！我将文件传上来吧！
我的图框块和甲方要求的不太一样，比如1.dwg图是现在制作的块，2.dwg图是插入以前的图块所得到的结果，因为图框尺寸发生了变化，且图框前两项也对换了位置，我就重新制作了一个图块（即文件1），但属性值并没有发生变化（即两个图块的属性是对应相等的）！
现在我想要把2图中的属性值提取出来，插入1图块后直接读取上述属性值就可以了！
可能表达还不是很清楚，请看图！谢谢！

似水无痕

我发现了一个东西，我用(setq x (car (entsel)))命令的到的x值，采用监视对话框依次点取1->2->3->4（点取蓝色部分）后出现了我所想要的属性值（红杠所示），就是不知道如何把他们提取出来，分别放入不同的几个变量！

eachy

未经测试

2. 
   
3. (defun c:tt (/ e el ne att attl obj)
   
4.   (if (and (setq e (car (entsel "\n拾取替换图块: ")))
   
5.            (setq el (entget e))
   
6.            (= (cdr (assoc 0 el)) "INSERT")
   
7.            (setq ne (getfiled "选择新图块" "" "dwg" 8))
   
8.       )
   
9.     (progn
   
10.       (if (= (cdr (assoc 66 e)) 1)
    
11.         (setq attl
    
12.                (mapcar '(lambda        (x)
    
13.                           (list        (vla-get-tagstring x)
    
14.                                 (vla-get-textstring x)
    
15.                           )
    
16.                         )
    
17.                        (safearray-value
    
18.                          (variant-value
    
19.                            (vla-getattributes (vlax-ename->vla-object e))
    
20.                          )
    
21.                        )
    
22.                )
    
23.               tf t
    
24.         )
    
25.       )
    
26.       (if (not  (tblsearch "block" (vl-filename-base ne)))
    
27.         (progn
    
28.           (vl-cmdf ".insert" ne)
    
29.           (command)
    
30.         )
    
31.       )
    
32.       (entmod
    
33.         (subst (cons 2 (vl-filename-base ne)) (assoc 2 el) el)
    
34.       )
    
35.       (if (and tf
    
36.                (= (vla-get-hasattributes
    
37.                     (setq obj (vlax-ename->vla-object e))
    
38.                   )
    
39.                   :vlax-true
    
40.                )
    
41.           )
    
42.         (progn
    
43.           (setq        att (safearray-value
    
44.                       (variant-value (vla-getattributes obj))
    
45.                     )
    
46.           )
    
47.           (mapcar '(lambda (x / at)
    
48.                      (if (setq
    
49.                            at (assoc (vla-get-tagstring x)
    
50.                                      attl
    
51.                               )
    
52.                          )
    
53.                        (vla-put-textstring x (cadr at))
    
54.                      )
    
55.                    )
    
56.                   att
    
57.           )
    
58.         )
    
59.       )
    
60.     )
    
61.   )
    
62.   (princ)
    
63. )

<br /> (defun c:tt (/ e el ne att attl obj)<br />   (if (and (setq e (car (entsel "\n拾取替换图块: ")))<br />            (setq el (entget e))<br />            (= (cdr (assoc 0 el)) "INSERT")<br />            (setq ne (getfiled "选择新图块" "" "dwg" 8))<br />       )<br />     (progn<br />       (if (= (cdr (assoc 66 e)) 1)<br />         (setq attl<br />                (mapcar '(lambda        (x)<br />                           (list        (vla-get-tagstring x)<br />                                 (vla-get-textstring x)<br />                           )<br />                         )<br />                        (safearray-value<br />                          (variant-value<br />                            (vla-getattributes (vlax-ename->vla-object e))<br />                          )<br />                        )<br />                )<br />               tf t<br />         )<br />       )<br />       (if (not  (tblsearch "block" (vl-filename-base ne)))<br />         (progn<br />           (vl-cmdf ".insert" ne)<br />           (command)<br />         )<br />       )<br />       (entmod<br />         (subst (cons 2 (vl-filename-base ne)) (assoc 2 el) el)<br />       )<br />       (if (and tf<br />                (= (vla-get-hasattributes<br />                     (setq obj (vlax-ename->vla-object e))<br />                   )<br />                   :vlax-true<br />                )<br />           )<br />         (progn<br />           (setq        att (safearray-value<br />                       (variant-value (vla-getattributes obj))<br />                     )<br />           )<br />           (mapcar '(lambda (x / at)<br />                      (if (setq<br />                            at (assoc (vla-get-tagstring x)<br />                                      attl<br />                               )<br />                          )<br />                        (vla-put-textstring x (cadr at))<br />                      )<br />                    )<br />                   att<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

似水无痕

谢谢eachy兄，程序已经下载了，里边有好多函数我见都没有见过，查书上也没有！我这里下载了两本函数书，都没有翻到！呵呵！
经过一步一步运行测试了程序，已经可以改过来了，不过有几个小问题：
1、(if (= (cdr (assoc 66 e)) 1)一句似乎应该是(if (= (cdr (assoc 66 el)) 1)；
2、程序运行后不能立即看到效果，必须在重新使用插入（insert）命令重新定义块后方可实现；
3、更改过来的图块中，“竣工图号”及“开竣工日期”好像挪动了一点位置！
本来我想根据你的程序自己更改一下，可惜好多函数看不懂，不知道应该在哪个地方修改，还请eachy兄多多体谅帮忙修改一下，谢谢了！
以下是2、3项的示意图！
2：该界面点击“是”，方可更改过来！

似水无痕

3：更改后属性值挪位情况！
啊！挪位我想，可能是两次定义的图框边界尺寸不同造成的！老图框底宽是380mm，新图框底宽是385mm！

eachy

1 你改对了
2 执行 regen 命令试试，或者在程序中增加 (vla-update obj)
3 位置挪动可能是字体或者对齐方式的原因，你可以查看先后两个块该属性的这两个文字特性
4查哪些书也不如 其中的 Help 联机帮助， Vla 函数 要查看 ActiveX and VBA Reference

似水无痕

最初由 eachy 发布
[B]1 你改对了
2 执行 regen 命令试试，或者在程序中增加 (vla-update obj)
3 位置挪动可能是字体或者对齐方式的原因，你可以查看先后两个块该属性的这两个文字特性
4查哪些书也不如 其中的 Help 联机帮助， Vla 函?.. [/B]

谢谢！我加了(vla-update obj)，好像还是不太行！
位置挪动我找到原因了，老图框尺寸和新图框有所不同，可能问题出在这里！
您说的查看联机帮助，我这里的全是e文，看的脑袋都大，全惯我以前没有好好学习，呵呵！
我刚才有运行了一次程序，那几个看不懂的函数现在有一点眉目了，主要是safearray-value variant-value及vla-getattributes等几个，我运行时看了监视对话框，大概猜到了一点！
我再好好研究一下这个程序，争取自己能够改成功！
再次感谢eachy兄的帮助，谢谢！

狂刀

属性挪位可能没有更好的办法,块替换和更新到可以有如下更简单的办法
[php]
(defun c:tt (/ e el ne att attl obj)
  (if (and (setq e (car (entsel "\n拾取替换图块: ")))
           (setq el (entget e))
           (= (cdr (assoc 0 el)) "INSERT")
           (setq ne (getfiled "选择新图块" "" "dwg" 4))
      )
      (command ".insert" (strcat (cdr (assoc 2 el))"=" ne) "y" ^c)
  )
  (princ)
)[/php]

qjcpj

以下这几个链接也挺不错的，有兴趣的可看一下：
http://www.mjtd.com/bbs/dispbbs. ... D=11957&page=30
请问怎样读取属性块中的数据？
http://discussion.autodesk.com/thread.jspa?threadID=428560
Attribute Modify Routine Nudge Needed
http://discussion.autodesk.com/thread.jspa?threadID=429643
Allow to change text within a block

似水无痕

谢谢楼上各位，我把eachy斑竹的程序改了一下，不过不太通用，仅仅适合我的图！有点太幼稚，不过在我这里还是感觉挺好用！我把更改后的程序贴出来，大家不要笑话！
[php](defun c:tt (/ e el ne att attl obj)
  (SETVAR "CLAYER" "0")
  (setvar "cmdecho" 0)
  (if (and (setq e (car (entsel "\n拾取替换图块: ")))
           (setq el (entget e))
           (= (cdr (assoc 0 el)) "INSERT")
           (setq ne
                  (getfiled
                    "选择新图块"
                    "C:/Documents and Settings/Owner/桌面/新建文件夹/A3图框块1"
                    "dwg"
                    8
                  )
           )
      )
    (progn
      (setq point   (cdr (assoc 10 el))
            xs            (cdr (assoc 41 el))
            ys            (cdr (assoc 42 el))
            zs            (cdr (assoc 43 el))
            b_angle (cdr (assoc 50 el))
      )
      (if (= (cdr (assoc 66 el)) 1)
        (PROGN
          (setq        attl
                 (mapcar '(lambda (x)
                            (vla-get-textstring x)
                          )
                         (safearray-value
                           (variant-value
                             (vla-getattributes (vlax-ename->vla-object e))
                           )
                         )
                 )
          )
          (ENTDEL E)
          (SETQ        LE (LENGTH ATTL)
          )
          (vl-cmdf ".insert"
                   ne
                   "X"
                   XS
                   "Y"
                   YS
                   "Z"
                   ZS
                   POINT
                   B_ANGLE
                   (NTH 0 ATTL)
                   (NTH 1 ATTL)
                   (NTH 2 ATTL)
                   (NTH 3 ATTL)
                   (NTH 4 ATTL)
          )
        )
      )
    )
  )
  (PRINC)
)[/php]
非常感谢eachy斑竹，我在你上边的程序里又学到了不少东西！
也感谢狂刀兄及qjcpj 长老，谢谢你们的热情帮助！