词典与扩展
(defun att-xdata(appname en fldname lst)
;fullname: attach xdata
;usage: to add field and initiate its contents in the entity in the appname
;for prevent the appname was abused, in "attach XData" function, the using of regapp
;is limited
(if (and (= (type en) 'ENAME) (= (type appname) 'STR) (/= appname "*"));whether input legal
(if (setq xlsts (cdr (assoc -3 (setq ent (entget en (list appname))))));whether run the "get-or-make-xdata" to create xdata of appname in the entity
(if (and (= (type fldname) 'STR) (null (getxdfield fldname (cdar xlsts))));whether field already exists, if it's, refer to "add-xdata-field"
(if (>
(xdroom en)
(xdsize
(setq xlst (list (cons appname (setxdfield fldname lst))))
)
);whether overflow
(entmod
(subst
(list -3 (cons appname (append (cdadr (assoc -3 ent)) (cdar xlst))))
(assoc -3 ent)
ent
)
)
nil
)
nil
)
nil
)
nil
)
)
(defun get-or-make-xdata(appname en fldname)
(if (= (type en) 'ENAME);whether input legal
(progn
(setq ent (entget en '("*")))
(setq ent_attapp (mapcar 'car (setq xlsts (cdr (assoc -3 ent)))))
(if (= (type appname) 'STR);whether input legal
(cond
((= appname "*") xlsts);to get all xdata of the entity
((member appname ent_attapp);whether xdata of appname has been created
(setq xlst (cdar (plstkread appname xlsts)))
(cond
((= fldname "*") xlst);to get xdata of appname in all fields
((and (= (type fldname) 'STR) (/= fldname "*"));to get xdata of appname in the field
(get-xdata-field fldname xlst)
)
(T nil)
)
)
((and (null fldname);to make xdata of appname at the entity
(not (entmod (append ent (list (list -3 (list appname))))))
)
(regapp appname)
(entmod (append ent (list (list -3 (list appname)))))
)
(T nil)
)
nil
)
)
nil
)
)
(defun getxdfield(fldname xlst);to decode the xdata point list which form was defined
(if (not (zerop (length (setq lst (member (cons 1000 fldname) xlst)))))
(if (= (cadr lst) '(1002 . "{"))
(progn
(setq flag nil lst (cddr lst))
(vl-remove-if
'(lambda(xi)
(if (= xi '(1002 . "}"))
(setq flag (not flag))
flag))
lst
)
(mapcar 'cdr lst)
)
(getxdfield fldname (cdr lst))
)
nil
)
)
(defun setxdfield(fldname lst);to encode the xdata point list which form was defined
(if (and (= (type fldname) 'STR) (listp lst))
(progn
(setq xlst (list (cons 1002 "}")))
(setq lst (reverse lst))
(while lst
(cond
((= (type (setq e (car lst))) 'STR)
(if (handent e)
(setq xlst (cons (cons 1005 e) xlst))
(setq xlst (cons (cons 1000 e) xlst))
)
)
((= (type e) 'LIST)
(if (and (= (length e) 3) (apply 'and (mapcar '(lambda(x)(= (type x) 'REAL)) e)))
(setq xlst (cons (cons 1010 e) xlst))
)
)
((= (type e) 'REAL)
(setq xlst (cons (cons 1040 e) xlst))
)
((= (type e) 'INT)
(setq xlst (cons (cons 1071 e) xlst))
)
)
(setq lst (cdr lst))
)
(setq xlst (append (list (cons 1000 fldname) (cons 1002 "{")) xlst))
)
nil
)
)
(defun plstkread(key plst / drlst)
(cond
((setq drlst (member (assoc key plst) plst))
(append (list (car drlst)) (plstkread key (cdr drlst)))
)
((null drlst)
nil
)
)
)
(defun get-or-make-dict(d_name)
(if (and (= (type d_name) 'STR)
(null
(setq dict_epty (dictsearch (namedobjdict) d_name))
)
)
(cond
((setq dict_en (entmakex '(0 . "DICTIONARY")(100 . "AcDbDictionary")))
(setq dict_en (dictadd (namedobjdict) d_name dict_en))
)
)
(cdr (assoc -1 dict_epty))
)
)
(defun get-or-make-Xrecord(dict_key xrec_key)
(cond
((and (= (type xrec_key) 'STR)
(setq dict_en (get-dict dict_key))
)
(cond
((setq xerc_epty (dictsearch dict_en xrec_key))
(setq xrec_en (cdr (assoc -1 xerc_epty)))
)
(T
(setq anXrec (entmakex '((0 . "XRECORD") (100 . "AcDbXrecord") )))
;DXF code:280 is0=1=2=...see freelancer
(if anXrec
(setq enXrec (dictadd dict_en xrec_key anXrec))
nil
)
)
)
)
(T nil)
)
)
