;; SaveData.lsp
;; Save *any* variable with the DWG
;; Written Nov 30, 1997.
;; Updated for r15 and xdict-* functions added Dec 7, 1999.
;;
;;*************************************************************
;; Copyright Vladimir Nesterovsky 1997, All Rights Reserved
;;
;; You may use, copy and distribute this program *unmodified*
;; for any non-commercial, non-profit purpose and without
;; charging any fee, if you keep this notice in its entirety
;; in all copies and in all your derived works.
;;
;; This program is provided "AS IS" and has absolutely
;; no warranty of any kind. Use it at your own risk.
;;
;; You're welcome to contact me about the possibility to use
;; this program commercially, and also with any comments and
;; requests at vnestr@netvision.net.il,
;; https://vnestr.tripod.com/
;;*************************************************************
;;
;; This file contains functions that will let you save any
;; list of data without dotted pairs inside dictionary with
;; (dict-put "mydict" "mykey" "myval")
;; and retrieve it later with
;; (dict-get "mydict" "mykey")
;; OR store it in xdictionary under some entity with
;; (xdict-put ename "mykey" "myval")
;; and retrieve it similarly with
;; (xdict-get ename "mykey")
;; xdictionary only allows for one key to hold the data,
;; regular dictionaries don't have this restriction, so you
;; may use any number of keys inside your dictionary
;;*************************************************************
;;
;; BEWARE that these functions use recursion in encoding / decoding
;; so for very long and complex lists they can use up all available
;; AutoLISP stack space and cause "AutoLISP stack overflow" error.
;;
;; look into https://vnestr.tripod.com/SaveData.txt !
;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
;;;;;;; The two working functions: ;;;;;;;
;;;;;;;____________________________;;;;;;;
;;
;;Sample use:
;; (dict-put "mydict" "mykey" '(1 (2 ("3" (44.4) (5.5 6.6 7.7) 8)) 999999))
;; (dict-get "mydict" "mykey")
;;POSSIBLE IMPROVEMENTS:
;; implement dict-append ( APPEND PREPEND )
;; Get A [Key] Value From Dictionary [Name]
(cond
((member (substr (getvar "acadver") 1 2) '( "13" "14"))
(defun dict-get ( name key ) ;; name and key As strings
(x-relist ;; decode the data!
(cdr (member '(100 . "AcDbXrecord")
(dict-getrawdata name key))))))
((= "15" (substr (getvar "acadver") 1 2))
(defun dict-get ( name key ) ;; name and key As strings
(x-relist ;; decode the data!
(cddr (member '(100 . "AcDbXrecord") ;; new (280) code group in r15
(dict-getrawdata name key)))))))
;; Put A [Val]ue Into [Name] Dictionary Under [Key]
;; Dictionary is created automatically if was not existing
;; three arguments As strings
;; NAME may also be an entity name of some existing dictionary
(defun dict-put ( name key val )
(dict-clear name key) ;; clear the old value under this Key
(dictadd
(setq name (cond ((dict-name name)) ((dict-new name)) ))
key
(entmakex
(cons '(0 . "XRECORD")
(cons '(100 . "AcDbXrecord")
(x-enlist val)))) ) ;; encode the data!
name ) ;; return the dictionary altered
;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
;; XDICTIONARY SUPPORT
;; two more similar functions to use:
;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
(defun xdict-put ( ename key val )
(addxdict ename (dict-put nil key val)))
(defun xdict-get ( ename key )
(dict-get (cdr (assoc 360 (entget ename))) key))
;;;;;;; utility functions in use ;;;;;;;
;; a general utility -- pop first value off the list
(defun pop (a / b)
(setq b (eval a))
(set a (cdr b))
(car b))
;; general functions re/en-list, just to try things out
;; re-list can be also used in decoding xdata
(defun re-list ( lst / tok )
(re-list-aux))
(defun re-list-aux()
(cond
((atom lst) lst)
((/= "}" (setq tok (pop 'lst)))
(cons (if (= "{" tok) (re-list-aux) tok)
(re-list-aux)))))
(defun en-list ( lst )
(cond
((null lst) lst)
((atom lst) (list lst))
((cons "{" ;; add the markers around the list!
(reverse
(cons "}"
(reverse
(apply 'append ;; open the lists
(mapcar 'en-list lst) ;; recursion!
))))))))
;; a special encoding function for Xrecords to be used in dictionaries
(defun x-enlist ( lst ) ;; encode!
(cond
((null lst) lst)
((atom lst) ;; automatic code groups
(cond
((= 'REAL (type lst))
(list (cons 40 lst)))
((= 'INT (type lst))
(if ;; special handling of long integers
(< -32768 lst 32767)
(list (cons 70 lst))
(list (cons 41 (float lst)))))
((= 'STR (type lst))
(list (cons 1 lst)))
(T nil)))
((and (cdr lst) (atom (cdr lst)))
(list lst)) ;; pass dotted pair AS IS -- must be valid!!
((and (= (length lst) 3)
(apply 'and (mapcar 'numberp lst)))
(list (cons 10 lst)))
((cons '(2 . "{")
(reverse
(cons '(2 . "}")
(reverse
(apply 'append
(mapcar 'x-enlist lst) ))))))))
(defun x-relist ( lst / tok ) ;; decode it!
(car (x-relist-aux)))
(defun x-relist-aux()
(cond
((null lst) nil)
((not (equal '(2 . "}") (setq tok (pop 'lst))))
(cons (if (equal '(2 . "{") tok)
(x-relist-aux)
(cond ;; special processing of TOK to recover
((= 41 (car tok)) ;; long integers back
(fix (cdr tok)))
(T
(cdr tok)))
)
(x-relist-aux)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dictionary functions for R14
;; POSSIBLE IMPROVEMENTS: support trees of dictionaries
;; now: all custom dictionaries are under the Root.
;;
;; Get Dictionary Object Name From Root Dictionary
(defun dict-name ( name ) ;; name As string or ename of exist dict
(cond
( (= 'STR (type name))
(cdr (assoc -1 (dictsearch (namedobjdict) name))))
( (and (= 'ENAME (type name))
(= "AcDbDictionary" (cdr (assoc 100 (entget name)))) )
name )))
;; Remove Dictionary [Name] From Root Dictionary
(defun dict-remove ( name / d0 ) ;; name As string
(if (dictsearch (Setq d0 (namedobjdict)) name)
(dictremove d0 name))
)
;; Make A New Empty Dictionary and put into into Root; Reset Existing.
(defun dict-new ( name / d0 ) ;; name As string
(cond
( (/= 'STR (type name))
(dict-new-orphan) )
('t
(if (dictsearch (Setq d0 (namedobjdict)) name)
(dictremove d0 name))
(dictadd d0 name
(dict-new-orphan) ))
))
;; (dict-new-ex parent name) parent := ROOT | ename (dict or reg for xdict)
(defun dict-new-orphan ()
(entmakex '((0 . "DICTIONARY")(100 . "AcDbDictionary"))))
;; List A Dictionary As Pairs {Name . Object Name}
(defun dict-list ( dname / d nl ) ;; dname As object name or string else ROOT
(cond
((and (Setq d (cond
((= 'ENAME (type dname))
dname)
((= 'STR (type dname))
(dict-name dname))
(T (namedobjdict))))
(Setq d (entget d)))
(while (setq d (member (assoc 3 d) d))
(if (or (= 350 (caadr d)) ;; regular dict
(= 360 (caadr d)) ;; extension dict
)
(setq nl (cons (cons (cdar d) (cdadr d)) nl)))
(setq d (cdr d)))
(reverse nl))))
;; Get Raw [Name] Dictionary Data for [Key]
(defun dict-getrawdata ( name key / d ) ;; name and key As strings
(cond
((='STR (type name))
(if (setq d (dict-name name))
(dictsearch d key)))
((='ENAME (type name))
(dictsearch name key) )
( (dictsearch (namedobjdict) key) )))
;; Clear The [Key] From Dictionary [Name]
(defun dict-clear ( name key / d) ;; name and key As strings
(if (setq d (dict-name name))
(dictremove d key)))
;; add xdictionary DK into the carrier entity data ECD
;; you can use it like (addxdict _entname_ (dict-put nil _key_ _val_))
;; eg. (addxdict (tblobjname"layer""0") (dict-put nil "MYDATA" 1.23))
;; to associate some data with layer "0".
;; you'll retrieve this data later with
;; (setq d (cdr(assoc 360 (entget (tblobjname "layer""0")))))
;; and
;; (dict-get d _key_)
(defun addxdict (ECD DK / TT)
(cond
( (= 'ENAME (type ecd))
(addxdict (entget ecd) dk) )
( (or (atom ecd) (atom (car ecd)) (not (atom (cdar ecd))))
nil )
( (= 'STR (type dk))
(addxdict ecd (dictsearch (namedobjdict) dk)) )
( (/= 'ENAME (type dk))
nil )
( (/= "AcDbDictionary" (cdr (assoc 100 (entget dk))))
nil )
( (assoc 102 ecd)
;; there already is an extension dictionary attached to this entity
;; can I prepend another dictionary into it?? No! :-(
(while (/= (caar ecd) 102)
(setq tt (cons (car ecd) tt)
ecd (cdr ecd)))
(setq tt (cons (car ecd) tt) ;; {
ecd (cdr ecd))
(while (/= 102 (caar ecd)) ;; }
(setq ecd (cdr ecd)))
(setq ecd (cons (cons 360 dk) ecd) )
(while tt
(setq ecd (cons (car tt) ecd)
tt (cdr tt)))
(entmod ecd))
( (assoc 100 ecd)
(while (/= (caar ecd) 100)
(setq tt (cons (car ecd) tt)
ecd (cdr ecd)))
(setq ecd
(cons (quote (102 . "{ACAD_XDICTIONARY"))
(cons (cons 360 dk)
(cons (quote (102 . "}")) ecd))))
(while tt
(setq ecd (cons (car tt) ecd)
tt (cdr tt)))
(entmod ecd))
))
;; EOF SaveData.lsp