有一个修改指定图块参照中指定属性的程序[求助]

wzh

我讲的不够清楚吗？换个方式讲我是说在《实用函数》栏目
中有一个修改指定图块参照中指定属性的程序，它是根据属
性标志和新的属性值组成的点对表来修改块属性值的程序，
能不能用属性提示和新的属性值组成的点对表来修改属性值
呢，请指教。

wzh

为什么没有人帮忙呢？

龙龙仔

wzh

我讲的不够清楚吗？换个方式讲我是说在《实用函数》栏目
中有一个修改指定图块参照中指定属性的程序，它是根据属
性标志和新的属性值组成的点对表来修改块属性值的程序，
能不能用属性提示和新的属性值组成的点对表来修改属性值
呢，请指教。

龙龙仔

;;用属性提示和新的属性值组成的点对表来修改属性值
;;USAGE: (ChangeAttributes (list (CAR(ENTSEL)) '(("处理" . "镀锌")("比例" . "1:4"))))
;;有相同属性提示的图块会不正确

(defun CHANGEATTRIBUTES        (LST / ITEM ATTS TMP_LIST TMP)

  (setq        TMP (vla-item
              (vla-get-blocks
                (vla-get-activedocument (vlax-get-acad-object))
              )
              (vla-get-name (vlax-ename->vla-object (car LST)))
            )
  )
  (vlax-for M2 TMP
    (if        (= (vla-get-objectname M2) "AcDbAttributeDefinition")
      (setq
        TMP_LIST (append TMP_LIST
                         (list (cons
                                 (vla-get-promptstring M2)
                                 (strcase (vla-get-tagstring M2))
                               )
                         )
                 )
      )
    )
  )

  (if (safearray-value
        (setq
          ATTS (vlax-variant-value
                 (vla-getattributes (vlax-ename->vla-object (car LST)))
               )
        )
      )
    (progn
      (foreach ITEM (cadr LST)
        (mapcar
          '(lambda (X)
             (if
               (= (strcase (cdr (assoc (car ITEM) TMP_LIST)))
                  (strcase (vla-get-tagstring X))
               )
                (vla-put-textstring X (cdr ITEM))
             )
           )
          (vlax-safearray->list ATTS)
        )
      )
      (vla-update (vlax-ename->vla-object (car LST)))
    )
  )
  (princ)
)

wzh