Vla方便获取和修改 Xrecord 数据

st788796

看到几个帖子求助关于 Xrecord ，抽了点时间自己写了一个，下面的程序可以列出附着在实体的 Xrecord 数据，

1. (defun c:ListXrc (/ e obj dicts xd xt lst)
   
2.   (if (and (setq e (car (entsel "\nSelect Object: ")))
   
3.     (setq obj (vlax-ename->vla-object e))
   
4.     (= (vla-get-hasExtensionDictionary obj) :vlax-true)
   
5.       )
   
6.     (progn
   
7.       (setq dicts (vla-GetExtensionDictionary obj))
   
8.       (vlax-for dict dicts
   
9. (if (= (vla-get-objectname dict) "AcDbXrecord")
   
10.    (progn
    
11.      (vla-getxrecorddata dict 'xt 'xd)
    
12.      (setq lst
    
13.      (cons
    
14.        (cons (vla-get-name dict)
    
15.       (mapcar
    
16.         '(lambda (x y)
    
17.     (cons x y)
    
18.          )
    
19.         (safearray-value xt)
    
20.         (mapcar 'variant-value (safearray-value xd))
    
21.       )
    
22.        )
    
23.        lst
    
24.      )
    
25.      )
    
26.    )
    
27. )
    
28.       )
    
29.     )
    
30.   )
    
31.   (foreach x lst
    
32.     (princ "\n")
    
33.     (princ x)
    
34.   )
    
35.   (princ)
    
36. )

(defun c:ListXrc (/ e obj dicts xd xt lst)<br />   (if (and (setq e (car (entsel "\nSelect Object: ")))<br />     (setq obj (vlax-ename->vla-object e))<br />     (= (vla-get-hasExtensionDictionary obj) :vlax-true)<br />       )<br />     (progn<br />       (setq dicts (vla-GetExtensionDictionary obj))<br />       (vlax-for dict dicts<br /> (if (= (vla-get-objectname dict) "AcDbXrecord")<br />    (progn<br />      (vla-getxrecorddata dict 'xt 'xd)<br />      (setq lst<br />      (cons<br />        (cons (vla-get-name dict)<br />       (mapcar<br />         '(lambda (x y)<br />     (cons x y)<br />          )<br />         (safearray-value xt)<br />         (mapcar 'variant-value (safearray-value xd))<br />       )<br />        )<br />        lst<br />      )<br />      )<br />    )<br /> )<br />       )<br />     )<br />   )<br />   (foreach x lst<br />     (princ "\n")<br />     (princ x)<br />   )<br />   (princ)<br /> )

命令: LISTXRC
Select Object:
(QLR_BSM (1001 . QLR_BSM) (1071 . 0))
(QLR_DJH (1001 . QLR_DJH) (1000 . 121100GCAA002))
(QLR_DLRDHHM (1001 . QLR_DLRDHHM) (1000 . ))
(QLR_DLRSFZMS (1001 . QLR_DLRSFZMS) (1000 . ))
(QLR_DLRXM (1001 . QLR_DLRXM) (1000 . 代理人))
(QLR_DLRZJH (1001 . QLR_DLRZJH) (1000 . 22222222222222222222222222222222222222))
(QLR_DLRZJLX (1001 . QLR_DLRZJLX) (1000 . 3 护照))
(QLR_FRDBDHHM (1001 . QLR_FRDBDHHM) (1000 . ))
(QLR_FRDBSFZMS (1001 . QLR_FRDBSFZMS) (1000 . ))
(QLR_FRDBXM (1001 . QLR_FRDBXM) (1000 . 法人代表))
(QLR_FRDBZJH (1001 . QLR_FRDBZJH) (1000 . 33333333333333333333333333333333333333))
(QLR_FRDBZJLX (1001 . QLR_FRDBZJLX) (1000 . 2 军官证))
(QLR_QLRMC (1001 . QLR_QLRMC) (1000 . 罗桑))
(QLR_QLRZJH (1001 . QLR_QLRZJH) (1000 . 1111111111111111111111111111))
(QLR_QLRZJLX (1001 . QLR_QLRZJLX) (1000 . 1 居民身份证))
(QLR_TDZH (1001 . QLR_TDZH) (1000 . 土地证号))
(SOUTH (1001 . SOUTH) (1000 . 罗桑))

能查询了，修改只要用 SetXrecordData 就可以了

st788796

一个简单修改程序

1. (defun c:tt (/ e obj name data dicts xd)
   
2.   (if (and (setq e (car (entsel "\nSelect Object: ")))
   
3.     (setq obj (vlax-ename->vla-object e))
   
4.     (= (vla-get-hasExtensionDictionary obj) :vlax-true)
   
5.     (setq Name (getstring "\nXrecord Name: "))
   
6.     (setq data (getstring "\nXrecord Data<String>: "))
   
7.       )
   
8.     (progn
   
9.       (setq dicts (vla-GetExtensionDictionary obj))
   
10.       (vlax-for dict dicts
    
11. (if (and (= (vla-get-objectname dict) "AcDbXrecord")
    
12.    (= (strcase (vla-get-name dict)) (strcase name))
    
13.      )
    
14.    (progn
    
15.      (vla-getxrecorddata dict 'xt 'xd)
    
16.      (setq xd (safearray-value xd))
    
17.      (vla-setxrecorddata
    
18.        dict
    
19.        xt
    
20.        (vlax-safearray-fill
    
21.   (vlax-make-safearray
    
22.     vlax-vbvariant
    
23.     '(0 . 1)
    
24.   )
    
25.   (list (car xd) (vlax-make-variant data vlax-vbstring))
    
26.        )
    
27.      )
    
28.    )
    
29. )
    
30.       )
    
31.     )
    
32.   )
    
33.   (princ)
    
34. )

(defun c:tt (/ e obj name data dicts xd)<br />   (if (and (setq e (car (entsel "\nSelect Object: ")))<br />     (setq obj (vlax-ename->vla-object e))<br />     (= (vla-get-hasExtensionDictionary obj) :vlax-true)<br />     (setq Name (getstring "\nXrecord Name: "))<br />     (setq data (getstring "\nXrecord Data<String>: "))<br />       )<br />     (progn<br />       (setq dicts (vla-GetExtensionDictionary obj))<br />       (vlax-for dict dicts<br /> (if (and (= (vla-get-objectname dict) "AcDbXrecord")<br />    (= (strcase (vla-get-name dict)) (strcase name))<br />      )<br />    (progn<br />      (vla-getxrecorddata dict 'xt 'xd)<br />      (setq xd (safearray-value xd))<br />      (vla-setxrecorddata<br />        dict<br />        xt<br />        (vlax-safearray-fill<br />   (vlax-make-safearray<br />     vlax-vbvariant<br />     '(0 . 1)<br />   )<br />   (list (car xd) (vlax-make-variant data vlax-vbstring))<br />        )<br />      )<br />    )<br /> )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

命令: TT
Select Object:
Xrecord Name: QLR_TDZH
Xrecord Data<String>: Myname
命令:
命令: LISTXRC
Select Object:
(QLR_BSM (1001 . QLR_BSM) (1071 . 0))
(QLR_DJH (1001 . QLR_DJH) (1000 . 121100GCAA002))
(QLR_DLRDHHM (1001 . QLR_DLRDHHM) (1000 . ))
(QLR_DLRSFZMS (1001 . QLR_DLRSFZMS) (1000 . ))
(QLR_DLRXM (1001 . QLR_DLRXM) (1000 . 代理人))
(QLR_DLRZJH (1001 . QLR_DLRZJH) (1000 . 22222222222222222222222222222222222222))
(QLR_DLRZJLX (1001 . QLR_DLRZJLX) (1000 . 3 护照))
(QLR_FRDBDHHM (1001 . QLR_FRDBDHHM) (1000 . ))
(QLR_FRDBSFZMS (1001 . QLR_FRDBSFZMS) (1000 . ))
(QLR_FRDBXM (1001 . QLR_FRDBXM) (1000 . 法人代表))
(QLR_FRDBZJH (1001 . QLR_FRDBZJH) (1000 . 33333333333333333333333333333333333333))
(QLR_FRDBZJLX (1001 . QLR_FRDBZJLX) (1000 . 2 军官证))
(QLR_QLRMC (1001 . QLR_QLRMC) (1000 . 罗桑))
(QLR_QLRZJH (1001 . QLR_QLRZJH) (1000 . 1111111111111111111111111111))
(QLR_QLRZJLX (1001 . QLR_QLRZJLX) (1000 . 1 居民身份证))
(QLR_TDZH (1001 . QLR_TDZH) (1000 . Myname))
(SOUTH (1001 . SOUTH) (1000 . 罗桑))

wzg35356

很好的示例，学了