为对象增加扩展数据

龙城飞将36

从网上找的，提供给大家

2. (defun XD-M()
   
3.        (while (not(setq en (entsel "选择一个实体：")))
   
4.               (alert "没选中任何实体...")
   
5.         )
   
6.        (princ "\n(现有")(princ(XDRoom(car en)))
   
7.        (princ "\n字节的扩展实体数据空间.)\n")
   
8.        (setq en (car en)
   
9.              un (getstring "\n应用名：")
   
10.        )
    
11.        (if  (XD-C en un)
    
12.             (progn (textscr)
    
13.                    (princ "\n这个应用名已经存在了，要覆盖它吗？")
    
14.                    (initget 7 "Yes No")
    
15.                    (if (= "Yes" (getkword "Yes/<No>:"))
    
16.                        ()
    
17.                        (abcdefg)
    
18.                    )
    
19.             )
    
20.         )
    
21.        (setq ll (list (cons 1002 "}")))
    
22.        (initget 7 "Real Integer String")
    
23.        (setq tp (getkword "Real(实数)/Integer(整数)/String(字串)："))
    
24.        (while (not(or (= tp "End")(= tp "")))
    
25.               (cond ((= tp "Real")
    
26.               (setq v (getreal "\n实型数：") l (cons 1040 v))
    
27.               )
    
28.               ((= tp "String")
    
29.               (setq v (getstring "\n字符串：") l (cons 1000 v))
    
30.               )
    
31.               ((= tp "Integer")
    
32.               (setq v (getint "\n整型数：") l (cons 1071 v))
    
33.               )
    
34.         )
    
35.         (setq ll (cons l ll))
    
36.         (initget 7 "Real Integer String End")
    
37.         (setq tp (getkword "Real(实数)/Integer(整数)/String(字串)/<End>："))
    
38.        )
    
39.        (setq ll (cons (cons 1002 "{") ll)
    
40.              ll (list -3 (cons un ll))
    
41.              el (entget en)
    
42.              nel (cons ll el)
    
43.        )
    
44.        (regapp un)(entmod nel)
    
45.   )

(defun XD-M()<br />        (while (not(setq en (entsel "选择一个实体：")))<br />               (alert "没选中任何实体...")<br />         )<br />        (princ "\n(现有")(princ(XDRoom(car en)))<br />        (princ "\n字节的扩展实体数据空间.)\n")<br />        (setq en (car en)<br />              un (getstring "\n应用名：")<br />        )<br />        (if  (XD-C en un)<br />             (progn (textscr)<br />                    (princ "\n这个应用名已经存在了，要覆盖它吗？")<br />                    (initget 7 "Yes No")<br />                    (if (= "Yes" (getkword "Yes/<No>:"))<br />                        ()<br />                        (abcdefg)<br />                    )<br />             )<br />         )<br />        (setq ll (list (cons 1002 "}")))<br />        (initget 7 "Real Integer String")<br />        (setq tp (getkword "Real(实数)/Integer(整数)/String(字串)："))<br />        (while (not(or (= tp "End")(= tp "")))<br />               (cond ((= tp "Real")<br />               (setq v (getreal "\n实型数：") l (cons 1040 v))<br />               )<br />               ((= tp "String")<br />               (setq v (getstring "\n字符串：") l (cons 1000 v))<br />               )<br />               ((= tp "Integer")<br />               (setq v (getint "\n整型数：") l (cons 1071 v))<br />               )<br />         )<br />         (setq ll (cons l ll))<br />         (initget 7 "Real Integer String End")<br />         (setq tp (getkword "Real(实数)/Integer(整数)/String(字串)/<End>："))<br />        )<br />        (setq ll (cons (cons 1002 "{") ll)<br />              ll (list -3 (cons un ll))<br />              el (entget en)<br />              nel (cons ll el)<br />        )<br />        (regapp un)(entmod nel)<br />   )

啵浪鼓

XD-C函数缺失
还有怎样读取扩展数据呢?

emk

楼主补下函数，XD-c  ， （abcdefg）？