(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)
? )
)
