怎么给一个图元增加扩展属性
各位大神，请教一下如何给一个图元增加扩展属性，代码应该怎么写？(entmod elist) ;; | ----------------------------------------------------------------------------
;; | XD_WriteX
;; | ----------------------------------------------------------------------------
;; | Function : Writes extended entity into an entity
;; | Argument : - entity name
;; | - list of data
;; | - Application Name (must be already registered)
;; | Return : complete entity list is returned if (XD_WriteX ...) is successful,
;; | else nil is returned
;; | Updated: August 11, 1998
;; | Comment: - Program can detect data types (STR, REAL,INT, LIST).
;; | - Entitiy handles must be prefixed by a "#" sign
;; | (eg. (XD_WriteX e (list "300XLCU" "#5DE")).
;; | - 1010 group stores points, which is a list of 3 reals
;; | - If you want to store a nested list, it should have {}
;; | - as the first element of the list
;; | e-mail : rakesh.rao@4d-technologies.com
;; | Web : www.4d-technologies.com
;; | ----------------------------------------------------------------------------
(defun XD_WriteX (ename xdLst AppName / entl xd)
(setq
xd (reverse (XD_WriteX@ xdLst))
xd (list -3 (cons AppName xd))
entl (append (entget ename) (list xd))
)
(entmod entl)
entl
)
)
(defun XD_WriteX@ (xdLst / xd xd1 itm)
(setq xd '())
(foreach itm xdLst
(cond
((and (= (type itm) 'LIST) (= (car itm) "{}"))
(setq
xd1 (cons (cons 1002 "}") (XD_WriteX@ (cdr itm)))
xd1 (append xd1 (list (cons 1002 "{")))
xd (append xd1 xd)
)
)
((and (= (type itm) 'LIST) (= (length itm) 3))
(setq xd (cons (cons 1010 itm) xd))
)
((and (= (type itm) 'STR) (= (substr itm 1 1) "#"))
(setq xd (cons (cons 1005 (substr itm 2)) xd))
)
((= (type itm) 'STR)
(setq xd (cons (cons 1000 itm) xd))
)
((= (type itm) 'INT)
(setq xd (cons (cons 1070 itm) xd))
)
((= (type itm) 'REAL)
(setq xd (cons (cons 1040 itm) xd))
)
)
)
xd
)
;语法：
;(ax:PUTXData Obj DATA)
;参数：
;obj:图元名
;XDATA:扩展数据
;如：(("south" (1000 . "204201") (1040 . 1.0))
; ("AAAA" (1041 . 562.307)(1000 . "aaaaa"))
; ("BBBB" (1000 . "bbbbbbb"))
; ("CCCC" (1041 . 752.569))
; )
;示例：
;(BF-PutXData myVlaObj '(("south" (1000 . "204201") (1040 . 1.0))))
;说明：
;对于图元上已经有的相同注册程序名的XDATA数据会覆盖
;功能：把扩展数据附着到ACAD图元上
;函数代码：
(defun BF-PutXData (Obj Data / dxf n i data_i temp1 appid)
(setq dxf(entget obj)
N (LENgth data)
i 0
data_i '(-3)
)
(repeat n
(setq temp1(nth i data)
appid (car temp1)
data_i (append data_i (list temp1))
i(1+ i)
)
(regapp appid)
(entmod (append dxf (list data_i)))
)
)
感谢各位分享，研究一下 怎么清除掉呢
页:
[1]