; DWGVAR.LSP  Copyright 1992-1999  Tony Tanzillo  All Rights Reserved
;
;
;                         DWGVAR.LSP
;
;                        Tony Tanzillo
;                 Design Automation Consulting
;
;           (First implemented on September 28, 1991)
;
; Requires AutoCAD Release 11 or greater.
; 
; DWGVAR.LSP
;
; API and toolkit for implementing application-defined drawing variables.
;
; DWGVAR.LSP is a generic application programming toolkit and interface
; that implements "drawing variables", allowing any AutoLISP application
; to easily define its own "variables" in drawings, and assign/reference
; their values via application-defined names.
;
; Once DWGVAR.LSP is loaded, your application can call it to define a
; new drawing variable, and assign a value to it using the following
; expression:
;
;   (setdwgvar "varname" <value> )
;
; The only types that are currently supported are strings, reals, and
; 16-bit integers (this will change in a future version of DWGVAR.LSP,
; while remaining backward-compatible with any data generated by this
; version).  Strings are limited to 255 characters.
;
; Once a value is assigned to a drawing variable, it will be retained
; and saved with the drawing file, and can then be retrieved using the
; following expression:
;
;   (getdwgvar "varname")
;
; Names of drawing variables are case-insensative (converted to upper
; case when stored in the drawing), can be any string (spaces or other
; special characters are also permitted) up to 255 characters long.
;
; If you call (getdwgvar) with the name of a non-existant variable, it
; will return NIL, and will _NOT_ generate an error condition.
;
; DWGVAR block and extended entity data structures:
; 
; R11 and R12 only:
;
; Drawing variables are stored in XDATA under the application name
; "DWGVARS", attached to an insertion of an anonymous block which
; is inserted into the definition of another block called "$DWGVARS$".
;
; This technique allows values of drawing variables to be fetched and
; modified without requiring a full database scan (as is the case when
; (ssget "x"....) must be called to find and retrieve entity data).
;
; Instead, only the block table must be scanned to locate the nested
; entity that contains the drawing variables in extended entity data.
;
; As long as the $DWGVARS$ block is not purged, drawing variables and
; their values will be preserved.  An insertion of this block is also
; placed into the entities section of the drawing, to ensure that it
; will be written to a new drawing that is created using the "*" form
; of the WBLOCK command (or with the "ALL" mode of object selection).
;
; Note that using ERASE ALL will cause the insertion of $DWGVARS$ to
; be erased from the entities section, which could result in a loss
; of the drawing variables if a WBLOCK * is subsequently performed in
; the same or a subsequent editing session.  A recommended precaution
; that could be taken to reduce the chances of this happening, is to
; insert a copy of $DWGVARS$ into a drawing at the start of an editing
; session, if the registered application name DWGVARS is not present
; in the REGAPP table, or there is no existing insertion of $DWGVARS$.
;
; Of course, this should serve to point out to Autodesk how important
; the need for a more sound means of storing application-defined data
; structures in drawing files is, without relying on the kludges that
; the developers of Autodesk's own applications must resort to in many
; cases.
; 
; R13 and later:
; 
; In R13 and later, Drawing variables are stored as XDATA attached
; to Layer 0 (the layer table record object, which is accessed via 
; the tblobjname function). Layer 0 cannot be deleted or purged, so
; drawing variables cannot be easily deleted by the user.
; 
; As such, drawing variables behave somewhat differently than they
; did in R12 and earlier:
; 
; 1.  In pre-13 versions, inserting a drawing that contains
;     drawing variables into one that does not, adds the
;     drawing variables in the drawing that is inserted to 
;     the current drawing. In R13 and later, drawing variables
;     cannot be transferred between drawings using INSERT or
;     any other means.
;     
; 2.  Drawing variables in an externally-referenced drawing
;     are not 'visible' to AutoLISP when editing the drawing
;     that contains the externally referenced file. This was
;     not directly possible with PRE-R13 versions, but it was
;     possible by accessing the externally-dependent block's
;     xdata directly via AutoLISP.
;     
; Converting PRE-R13 drawing variables to R13 format.
; 
; When editing a drawing that contains drawing variables
; stored in PRE-R13 format, you can convert the drawing
; variables to R13 format using the following routine:
; 
;   (UpgradeDwgVars)
;   
; However, be warned that this will overwrite ALL drawing 
; variables stored in R13 format.
;     
; <end release-specific notes>
;     
; Warning!
;
; Notice that there is absolutlely NO checking done to determine if the
; amount of extended entity data used by the drawing variables (this
; includes the names of the variables as well), is too large to attach
; to a single entity.
;
; I decided not to complicate things, since I wrote DWGVAR.LSP for my
; own use, and did not feel that I would ever need to store that much
; data (~16KB) in my drawing variables.
;
; You could easily modify DWGVAR to support multiple "slots" for each
; application that needs to maintain drawing variables, but how you
; would go about that is up to you, and your particular requirements.
;
; Undo and drawing variables:
;
; Remember that modifications to drawing variables are written directly
; to extended entity data as they occur, and as such, can be UNDONE by
; the user or by an application via the UNDO command.  This particular
; facet of drawing variables can also be taken advantage of to place an
; application variable under control of the UNDO complex.
;
; Extended entity data structure:
;
;     (-3 ("DWGVARS" (1000 . "VARNAME1")
;                    (10xx . <value1> )
;                    (1000 . "VARNAME2")
;                    (10xx . <value2> )
;                    (1000 . "VARNAMEn")
;                    (10xx . <valueN> )
;         )
;     )
;
; Constants:

  (setq app:dwgvars '("DWGVARS")   ; APPID
        $dwgvars$    "$DWGVARS$"   ; Container block name
        dvarbag      "$DWGVARBAG$" ; sub-continer block holding xdata
        dvar_verno   1.0           ; Dwgvar Xdata version sentinel
  )

; Register DWGVAR application id:

  (regapp (car app:dwgvars))

; Bomb if application isn't registered:

  (if (not (tblsearch "appid" (car app:dwgvars)))
      (progn (princ "\nUnable to register application: DWGVARS.")
             (princ "  - Aborting.")
             (exit))
  )

; --------------------------------------------------------------------------
; Function: GetDwgVar
;
; Function for retrieving value of a drawing variable.
;
; Syntax: (GetDwgVar <name> )
;
; <name> is the case-insentitive string name of the drawing 
; variable to retrieve.
;
; Returns the current value of <name> if it exists, or NIL.

  (defun GetDwgVar (name / b d)
     (cond
        (  (not (and (dwgvarblock)
                     (setq b (dvar_ent))
                     (setq d (assoc -3 (entget b app:dwgvars)))
                     (setq d (cdadr d))
                     (dvar_ver (cdar d))
                     (setq d (member (cons 1000 (dvar_str name)) d))))
           (return nil))
        (t (cdadr d)))
  )

; --------------------------------------------------------------------------
; Function: SetDwgVar
;
; Function to initialize and/or assign a value to a drawing variable.
;
; Syntax: (SetDwgVar <name> <value> )
;
; Assigns <value> to the drawing variable <name>.  If the parameter
; <name> already exists, <value> replaces its existing value.
;
; If the drawing variable <name> doesn't currently exist, then a new
; parameter with the name of <name> is initialized, and is assigned to
; the specified <value>.
;
; <name> is case-insensetive and can contain spaces or other special
; characters (255 max).
;
; <value> must be a real, integer, or string data type (a maximum of
; 255 characters for strings).
;
; Strings (both parameter names and values) are checked for length,
; and are truncated to 255 characters, if they are longer.
;
; parameter names are automatically converted to upper-case strings.

  (defun SetDwgVar (name value / vdata old ent vtype)
     (setq name  (dvar_str name)
           vtype (cond
                    (  (not (and (setq vdata (dvar_read))
                                 (setq old (assoc name vdata))))
                       (dvar_type name value))
                    (  (eq (type (caddr old))
                           (type value))
                       (cadr old))
                    (t (dvar_type name value))))

     (if (eq vtype 1000)
         (setq value (substr value 1 255))
     )

     (dvar_xdput (dvar_xdlist (put (list (list name vtype value)) vdata)))
     (return value)
  )

; --------------------------------------------------------------------------
; Function: REMDWGVAR (api)
;
;   (remdwgvar <name> )
;
; Permanently unbinds (removes) a drawing variable from a drawing.
;
; If <name> exists and is made unbound, its value is returned.

  (defun remdwgvar (name / d v)
     (cond
        (  (not (setq v (dvar_read))) nil)
        (  (eq (setq name (dvar_str name)) "*")
           (dvar_write nil)
           (return nil))
        (  (not (setq d (assoc name v)))
           (return nil))
        (  (eq (length v) 1)
           (dvar_write nil)
           (return nil))
        (t (dvar_write
              (reverse
                 (append (cdr (member d v))
                         (cdr (member d (reverse v))))))
           (return (caddr d))))
  )

; --------------------------------------------------------------------------
; Function: GetDwgVars
;
; API function to retrieve the names/values of multiple drawing 
; variables in the form of an AutoLISP association list taking
; the form:
; 
;         ((<varname> . <value>)...)
;
; Syntax: (GetDwgVars <pattern> )
;         (GetDwgVars '(<VarName>...))
;
; <pattern> is a (wcmatch)-type wild-card pattern filter,
; or a list of variable names.
;
; If <pattern> is Nil, it defaults to "*".

  (defun GetDwgVars (pat)
     (cond
        (  (not (dwgvarblock)) nil)
        (  (and pat (listp pat))
           (getdwgvarlist pat))
        (  (eq "*" (setq pat (dvar_str (cond (pat) (t "*")))))
           (mapcar
             '(lambda (x)
                 (cons (car x) (caddr x)))
              (dvar_read)))
        (t (apply 'append
              (mapcar
                '(lambda (x)
                    (if (wcmatch (car x) pat)
                        (list (cons (car x) (caddr x)))))
                 (dvar_read)))))
  )
  
  (defun getdwgvarlist (vars / vdata)
     (setq vdata (dvar_read))
     (apply 'append
        (mapcar 
          '(lambda (var / v)
              (if (setq v (assoc (strcase var) vdata))
                 (list (cons (car v) (caddr v)))
              )
           )
           vars
        )
     )
  )

  ;; Get pre-R13 drawing variables 
  ;; regardless of version running.
    
  (defun GetDwgVars12 (pat)
     (  (lambda (dvar_ent)
           (getdwgvars pat)
        )
        dvar_ent12
     )
  )
  
  ;; Converts all PRE-R13 format drawing variables
  ;; to R13 format.
  ;; 
  ;; Warning: calling this routine will completely
  ;; destroy any existing drawing variables stored
  ;; in R13 format.
  
  (defun UpgradeDwgVars ( / data)
     (if (setq data (getdwgvars12 nil))
          (setdwgvars data)
     )
  )

; --------------------------------------------------------------------------
; Function: SetDwgVars (api)
;
; Function to set multiple drawing variables from a LISP association list.
; Existing parameters are modified and new parameters are added.
;
; parameters and their values must be passsed in an AutoLISP association
; list in the following form:
;
;   ((<name> . <value>)...)
;
; Where <name> (a string) is the name of the parameter, and <value> is
; the value that is to be assigned to the parameter.

  (defun SetDwgVars (alist)
     (dvar_put (dvar_dvlist alist))
     (return alist)
  )

; ==========================================================================
; Auxillary (internal) functions used by DWGVAR API functions.
;
; The following functions do not need to be called by your applications.
;
; --------------------------------------------------------------------------
; Function: DVAR_VER
;
; Determines if dwgvar xdata is compatible with this version of library.
;
  (defun dvar_ver (ver)
     (cond
        (  (or (not ver)
               (/= (type ver) 'real)
               (> ver dvar_verno))
           (princ "\nError [DWGVAR]: drawing variables created by ")
           (princ "newer version of DWGVAR.LSP.\n")
           (exit)
        )
        (t))
  )

; --------------------------------------------------------------------------
; Function: PUT
;
;    (put <list1> <list2> )
;
; Incorporates contents of <list1> into <list2>.  If corresponding property
; value pair already exists in <list2>, its value is replaced with the value
; of the corresponding pair in <list1>.  Otherwise, the property-value pair
; in <list1> is added to <list2>.

  (defun put (clauses alist)
     (put1 (reverse clauses) alist)
  )

; Recursive auxillary function for (put);

  (defun put1 (clauses alist / old)
     (cond (  (not clauses) alist)
           (  (not alist) clauses)
           (t (put1 (cdr clauses)
                    (cond (  (setq old (assoc (caar clauses) alist))
                             (subst (car clauses) old alist))
                          (t (cons (car clauses) alist))))))
  )

  (defun return (value) value)

; --------------------------------------------------------------------------
; Function: DVAR_INIT (black box)
;
; Initializes the container blocks for storing drawing variables.
;
; Returns the entity name of the nested insertion of an anonymous block
; which all drawing variable extended entity data is to be attached to.
;
; This function also undefines itself when it executes, since it should
; never need to be called more than once in an editing session.

  (defun dvar_init ( / bname)
     (regapp (car app:dwgvars))
     (entmake
       '(  (0 . "BLOCK")
           (2 . "$DWGVARBAG$")
           (10 0 0 0)
           (70 . 0)
        )
     )
     (setq bname (entmake '((0 . "endblk"))))
     (entmake
       '(  (0 . "BLOCK")
           (2 . "$DWGVARS$")
           (10 0 0 0)
           (70 . 0)
        )
     )
     (entmake
        (append
           (list
             '(0 . "insert")
             '(2 . "$DWGVARBAG$")
           )
          '(  (10 0 0 0)
              (8 . "0")
              (6 . "BYLAYER")
              (70 . 0)
           )
        )
     )
     (entmake '((0 . "endblk")))
     (entmake
       '(  (0 . "INSERT")
           (2 . "$DWGVARS$")
           (10 0 0 0)
           (8 . "0")
           (6 . "BYLAYER")
           (210 0 0 0)
           (70 . 0)
        )
     )
     (setq dvar_init nil)
     (setq dvar_ename (get -2 (block? $dwgvars$)))
  )

; --------------------------------------------------------------------------
; Function: DVAR_READ (internal)
;
; Retrieves drawing variable XDATA and converts to LISP association
; list in the form:
;
;  (("VARNAME" <xdata group code> <value>)...)

  (defun dvar_read ( / d)
     (cond
        (  (not (setq d (dvar_xdget)))
           (return nil))
        (t (dvar_alist d)))
  )

; --------------------------------------------------------------------------
; Function: DVAR_WRITE (internal)
;
; Creates drawing variables from all values in argument list, which is of
; the same type as the list returned by (dvar_read).  Existing parameters
; are discarded.

  (defun dvar_write (dvlist)
     (dvar_xdput (dvar_xdlist dvlist))
     (return dvlist)
  )

; --------------------------------------------------------------------------
; Function: DVAR_PUT (internal)
;
; Adds the parameters in the argument list (an association list of the type
; returned by (dvar_read)) to the existing drawing variables.  This is a
; "put" operation (existing parameters are modified, and new parameters are
; added).

  (defun dvar_put (dvlist)
     (dvar_write (put dvlist (dvar_read)))
  )

; --------------------------------------------------------------------------
; Function: DVAR_ALIST (internal)
;
; Converts DWGVAR XDATA list to LISP association list.
;
;   Input list: ((1000 . "VARNAME") (10xx . <value>)...)
;
;  Output list: (("VARNAME" 10xx <value>)...)

  (defun dvar_alist (xdata / result)
     (while xdata
        (setq result
                (cons (list (cdar xdata) (caadr xdata) (cdadr xdata)) result)
              xdata
                (cddr xdata)))
     (return result)
  )

; --------------------------------------------------------------------------
; Function: DVAR_DVLIST (internal)
;
; Converts LISP association list to DWGVAR association list.
;
;   Input list: (("VARNAME". <value>)...)
;
;  Output list: (("VARNAME" 10xx <value>)...)

  (defun dvar_dvlist (alist)
     (mapcar
       '(lambda (x)
           (list (dvar_str (car x))
                 (dvar_type (car x) (cdr x))
                 (if (eq (type (cdr x)) 'str)
                     (substr (cdr x) 1 255)
                     (cdr x))))
        alist
     )
  )

; --------------------------------------------------------------------------
; Function: DVAR_XDLIST (internal)
;
; Converts DWGVAR association list data back to XDATA list.
;
;  Input list: (("VARNAME" 10xx <value>)...)
;
; Output list: ((1000 . "VARNAME") (10xx . <value>)...)

  (defun dvar_xdlist (alist / result)
     (foreach clause alist
        (setq result
           (cons (cons 1000 (dvar_str (car clause)))
                 (cons (apply 'cons (cdr clause)) result))))
     (return result)
  )

; --------------------------------------------------------------------------
; Function: DVAR_TXDLIST (internal)
;
; Converts normal LISP association list data to DWGVAR XDATA list with
; default data types.  This is the same as DVAR_XDLIST, except that
; types are not explicitly required in the input list, and default to
; the type produced by passing each <value> to DVAR_TYPE.
;
;  Input list: (("VARNAME" . <value>)...)
;
; Output list: ((1000 . "VARNAME") (10xx . <value>)...)

  (defun dvar_txdlist (alist / result)
     (foreach clause alist
        (setq result
              (cons (cons 1000 (dvar_str (car clause)))
                    (cons (cons (dvar_type (car clause) (cdr clause))
                                (cdr clause))
                          result))))
     (return result)
  )

  ; Note: This function is currently not used.

  (setq dvar_txdlist nil)

; --------------------------------------------------------------------------
; Function: DVAR_TYPE (internal)
;
; Returns xdata group code for basic supported data types.

  (setq dvar_types '(

     (str  . 1000)
     (real . 1040)
     (int  . 1070)
     (list . 1010)

  ))

  (defun block? (name)
     (tblsearch "block" name)
  )
  
  (defun && (a b) (> (logand a b) 0))
  
  (defun get (k l) (cdr (assoc k l)))
  
  (defun dvar_type (name val)
     (cond
        (  (cdr (assoc (type val) dvar_types)))
        (t (princ (strcat "\nError [DWGVAR] Illegal data type: " 
                          name " = "))
           (prin1 val) 
           (princ " (type = ")
           (prin1 (type val))
           (princ ")")
           (exit)))
  )

; --------------------------------------------------------------------------
; Function: DVAR_STR
;
; Modifies strings to max of 255 characters and converts to upper case.
;
; Used on parameter names.  (string values are literal).

  (defun dvar_str (s)
     (strcase (substr s 1 255))
  )

; --------------------------------------------------------------------------
; Function: dvar_xdput/dvar_xdget
;
; Syntax: (dvar_xdput <xdata> )
;         (dvar_xdget)
;
; Low level data accessor/modifier.


  (defun dvar_xdput (xdata)
     (entmod
        (list (cons -1 (dvar_ent))
              (list -3 (cons (car app:dwgvars)
                             (cons (cons 1040 dvar_verno) xdata)))))
  )

  (defun dvar_xdget ( / d)
     (if (and (setq d (entget (dvar_ent) app:dwgvars))
              (setq d (assoc -3 d))
              (dvar_ver (cdr (cadadr d))))
         (return (cddadr d)))
  )

; --------------------------------------------------------------------------
; Function: DVAR_ENT
;
; Returns name of entity that has dwgvar XDATA attached.  If there is no
; $dwgvar$ block, then it is initialized.

  (defun r13? ()
     (or (getvar "PICKSTYLE"))
  )
  
  (defun r14? ()
     (or (getvar "CURSORSIZE"))
  )
  
  ;; For pre-r13 drawing variables.

  (defun dvar_ent12 ()
     (regapp (car app:dwgvars))
     (cond
        (dvar_ename)
        (  (or (not (setq dvar_ename (get -2 (block? $dwgvars$))))
               (&& 1 (get 70 (entget dvar_ename))))
           (dvar_init))
        (t dvar_ename))
  )
  
  (cond
     (  (not (r13?))
        (setq dvar_ent dvar_ent12)
        (defun dwgvarblock ()
           (tblsearch "block" $dwgvars$)
        )
     )
     
     (t  ;; R13 and later
   
        (defun dvar_ent ()
           (tblobjname "LAYER" "0")
        )
        (defun dwgvarblock () t)
     )
  )
       
  (defun C:DVLIST ( / pattern vars *float-prec*)
     (setq pattern (getstring "\nVariables to list <*>: ")
           *float-prec* 6)
     (setq pattern (strcase (cond ((eq pattern "") "*") (t pattern))))
     (cond
        (  (setq vars (GetDwgVars pattern))
           (dvlist vars))
        (t (princ (strcat "\nNo variables found matching " pattern))))
     (princ)
  )
  
  (setq blank_field "                ")
  (setq blank_width (strlen blank_field))
  
  (defun dvlist (vars)
     (textscr)
     (foreach var vars
        (princ (strcat "\n" (car var)
                  (substr "                           "
                     1 (- blank_width (strlen (car var))))))
        (prin1 (cdr var))
     )
     (princ)
  )
  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EOF DWGVAR.LSP ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;