;;================================================================================
;;|              Copyright © Menhirs NV. All rights reserved.                    |
;;================================================================================

;; VLE Library Emulation for AutoCAD 2000 and higher, and for all BricsCAD versions
;;
;; VLE Library provides a number of useful functions for AutoLISP developers.
;; Under BricsCAD V12.2 and higher, these functions are 'built-in', providing
;; significant performance improvements (besides comfort and functionality).
;;
;; To keep AutoLISP code compatible under all BricsCAD and AutoCAD platforms
;; and versions, AutoLISP applications can simply load this file in AutoCAD
;; and BricsCAD, under all versions;
;; as BricsCAD V12.2 and higher provide these VLE functions as 'built-in',
;; loading this file has no impact at all (VLE functions from this file are
;; only defined when the built-in functions are not present).
;;
;; Because the BricscCAD built-in VLE function set will grow with each BricsCAD
;; version, it is a good idea to load this file under Bricscad always
;; (taken from the latest version of BricsCAD, copied to the application)
;;
;; All those VLE functions, which have no useful meaning under AutoCAD are
;; implemented as 'no operation', so AutoLISP code is not affected in negative
;; sense.
;;
;; Portions of code and ideas were gratefully taken from :
;;    Lee Mac Programming, http://www.lee-mac.com
;;

(vl-load-com)

(setq *program* (strcase (getvar "PROGRAM")))
(setq *isAcad* (= *program* "ACAD"))
(setq *isBcad* (= *program* "BRICSCAD"))


;;================================================================================
;;                        SOME GLOBAL CONSTANTS
;;================================================================================
(if (not vlax-vbInt64) (setq vlax-vbInt64 20)) ;; 64 bit integer for vlax-make-variant/safearray


;;
;; if Vlisp-Optimizer is present (BricsCAD), then disable analysis + optimisation for this file
;;
(if vlisp-optimizer (vlisp-optimizer nil)) ;; disable VLisp-Optimizer, if present


;;================================================================================
;;| SYMBOL : vle-extensions-active                                               |
;;|------------------------------------------------------------------------------|
;;| indicates that VLE extensions are present - here, by emulation               |
;;| Values : T    if VLE is present                                              |
;;|          NIL  if VLE is not present                                          |
;;================================================================================
(setq vle-extensions-active t)


;;================================================================================
;;          other BricsCAD Lisp Functions (old-style, uncategorized)
;;================================================================================

(if (not remove)   (setq remove vl-remove))
(if (not position) (setq position vl-position))


;;================================================================================
;;                      LISP Optimiser Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-optimizer                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-optimizer enableFlag)                                                   |
;;|                                                                              |
;;| enables or disables "Lisp Optimiser" features, which analyses (defun) code   |
;;| blocks at load-time to optimise inefficient code to be more efficient        |
;;| (i.e. by combining statements into efficient built-in VLE functions)         |
;;|                                                                              |
;;| Arguments : 'enableFlag'  T enables, NIL disables the Optimiser              |
;;|                                                                              |
;;| Return    :  previous activation status                                      |
;;|                                                                              |
;;| Alias     :  vlisp-optimiser                                                 |
;;================================================================================
(if (not vlisp-optimizer)
  (defun vlisp-optimizer ( enable ) enable)
)
(if (not vlisp-optimiser) (setq vlisp-optimiser vlisp-optimizer))
(if (not vle-optimizer)   (setq vle-optimizer  vlisp-optimizer))
(if (not vle-optimiser)   (setq vle-optimizer  vlisp-optimiser))


;;================================================================================
;;                      LISP Entity Functions
;;================================================================================

;; get dictionary ename from dictionary string
(defun __getDictEnameFromName ( name / nod elist )
  (setq name (strcase name) nod (namedobjdict))
  (if (member name '("ACAD_COLOR" "ACAD_DETAILVIEWSTYLE" "ACAD_GROUP" "ACAD_IMAGE_VARS" "ACAD_LAYOUT"
                      "ACAD_MATERIAL" "ACAD_MLEADERSTYLE" "ACAD_MLINESTYLE" "ACAD_PLOTSETTINGS"
                      "ACAD_PLOTSTYLENAME" "ACAD_SCALELIST" "ACAD_SECTIONVIEWSTYLE" "ACAD_TABLESTYLE"
                      "ACAD_VISUALSTYLE" "ACDBVARIABLEDICTIONARY"
                    )
      )
    (setq elist (dictsearch nod name))
  )
  (cdr (assoc -1 elist))
)

;;================================================================================
;;| FUNCTION : vle-entget                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-entget dxf ename)                                                       |
;;|                                                                              |
;;| retrieves the entity's property value for specified DXF group code;          |
;;| in typical case, this is a high-performance replacement for usual code like  |
;;| (cdr (assoc dxf (entget ename)))                                             |
;;|                                                                              |
;;| Arguments : 'dxf'   the DXF group code to retrieve                           |
;;|           : 'ename' the entity's ename                                       |
;;|                                                                              |
;;| Return    :  the value for specified DXF group code as plain Lisp data       |
;;|                                                                              |
;;| Example   :  (vle-entget 62 entity) returns the color for entity             |
;;|                                                                              |
;;| Notes :  (vle-entget) does always return a non-NIL value for omitted         |
;;|          "default" values (ByLayer etc.); NIL if 'dxf' code is not supported |
;;|          by the entity                                                       |
;;================================================================================
;; constants used by (vle-entget) + (vle-entget-m)
(setq _vle:dxf_6_default   (cons 6 "ByLayer"))
(setq _vle:dxf_38_default  (cons 38  0.0))
(setq _vle:dxf_39_default  (cons 39  0.0))
(setq _vle:dxf_48_default  (cons 48  1.0))
(setq _vle:dxf_60_default  (cons 60  0))
(setq _vle:dxf_62_default  (cons 62  256))
(setq _vle:dxf_67_default  (cons 67  0))
(setq _vle:dxf_370_default (cons 370 -1))
(setq _vle:dxf_440_default (cons 440 0))

(if (not vle-entget)
  (defun vle-entget ( dxf ename / res )
    (if (not (setq res (cdr (assoc dxf (entget ename)))))
      (cond  ;; retrieve omitted default values
        ((= dxf 6)   (setq res (cdr _vle:dxf_6_default)))   ;; linetype
        ((= dxf 38)  (setq res (cdr _vle:dxf_38_default)))  ;; elevation
        ((= dxf 39)  (setq res (cdr _vle:dxf_39_default)))  ;; thickness
        ((= dxf 48)  (setq res (cdr _vle:dxf_48_default)))  ;; linetype scale
        ((= dxf 60)  (setq res (cdr _vle:dxf_60_default)))  ;; visibility 0=visible
        ((= dxf 62)  (setq res (cdr _vle:dxf_62_default)))  ;; color 256=ByLayer
        ((= dxf 67)  (setq res (cdr _vle:dxf_67_default)))  ;; modelspace / paperspace entity 0=modelspace
        ((= dxf 370) (setq res (cdr _vle:dxf_370_default))) ;; lineweight -1=ByLayer
        ((= dxf 440) (setq res (cdr _vle:dxf_440_default))) ;; transparency 0=ByLayer
      )
    )
    res
  )
)

;;================================================================================
;;| FUNCTION : vle-entget-m                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-entget-m dxfCodes ename)                                                |
;;|                                                                              |
;;| retrieves the entity's property values for specified DXF group codes,        |
;;| returns a list of (dxf . value) assoc items;                                 |
;;| DXF group codes are specified as a list;                                     |
;;|                                                                              |
;;| Arguments : 'dxfCodes' list of DXF group codes to be retrieved               |
;;|           : 'ename'    the entity's ename                                    |
;;|                                                                              |
;;| Return    :  list of assoc items '((dxf1 . value1)(dxf2 . value2) ...)       |
;;|                                                                              |
;;| Example   :  (vle-entget-m '(8 62 39) entity)                                |
;;|              returns '((8 . "LayerX")(62 . 4)(39 . 0.0))                     |
;;|                                                                              |
;;| Notes :  (vle-entget-m) does always return non-NIL values for omitted        |
;;|          "default" values (ByLayer etc.);                                    |
;;|          if the entity does not support particular dxf code, that dxf code   |
;;|          is not part of returned list then                                   |
;;================================================================================
(if (not vle-entget-m)
  (defun vle-entget-m ( dxfCodes ename / elist dxf res resLst )
    (setq elist (entget ename))
    (foreach dxf dxfCodes
      (if (setq res (assoc dxf elist))
        (setq resLst (cons res resLst))
        (cond  ;; retrieve omitted default values
          ((= dxf 6)   (setq resLst (cons _vle:dxf_6_default   resLst))) ;; linetype
          ((= dxf 38)  (setq resLst (cons _vle:dxf_38_default  resLst))) ;; elevation
          ((= dxf 39)  (setq resLst (cons _vle:dxf_39_default  resLst))) ;; thickness
          ((= dxf 48)  (setq resLst (cons _vle:dxf_48_default  resLst))) ;; linetype scale
          ((= dxf 60)  (setq resLst (cons _vle:dxf_60_default  resLst))) ;; visibility 0=visible
          ((= dxf 62)  (setq resLst (cons _vle:dxf_62_default  resLst))) ;; color 256=ByLayer
          ((= dxf 67)  (setq resLst (cons _vle:dxf_67_default  resLst))) ;; modelspace / paperspace entity 0=modelspace
          ((= dxf 370) (setq resLst (cons _vle:dxf_370_default resLst))) ;; lineweight -1=ByLayer
          ((= dxf 440) (setq resLst (cons _vle:dxf_440_default resLst))) ;; transparency 0=ByLayer
        )
      )
    )
    (reverse resLst)
  )
)

;;================================================================================
;;| FUNCTION : vle-entget-massoc                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-entget-massoc dxfCode ename)                                            |
;;|                                                                              |
;;| returns a list of all values using same key 'dxfCode' in the (entget) list   |
;;| of an entity 'ename'                                                         |
;;|                                                                              |
;;| Arguments : 'dxfCode'  key to be used to parse the (entget) list of 'ename'  |
;;|             'ename'  entity name                                             |
;;|                                                                              |
;;| Return    : a list of all cdr values of assoc items with key 'dxfCode';      |
;;|             all values are in their original sequence                        |
;;|                                                                              |
;;| Example   : assume 'pline' to be a LWPOLYLINE with 4 vertices                |
;;|             (vle-entget-massoc 10 pline)                                     |
;;|      =>  ((11.08 76.272)(14.54 14.2)(23.45 16.71)(26.18 11.62)(19.84 5.064)) |
;;================================================================================
(if (not vle-entget-massoc)
  (defun vle-entget-massoc ( dxfCode ename )
    (mapcar 'cdr (vl-remove-if-not '(lambda (item) (eq dxfCode (car item))) (entget ename)))
  )
)

;;================================================================================
;;| FUNCTION : vle-entmod                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-entmod dxf ename value)                                                 |
;;|                                                                              |
;;| modifies the entity's property value for specified DXF group code;           |
;;| in typical case, this is a high-performance replacement for usual code like  |
;;| (entmod (subst (cons dxf value) olditem lst))                                |
;;|                                                                              |
;;| Arguments : 'dxf'   the DXF group code to set the new value for              |
;;|           : 'ename' the entity's ename                                       |
;;|           : 'value' new value to be set for the entity's property            |
;;|                                                                              |
;;| Return    :  T   if the entity's value has been updated (or is identical)    |
;;|              NIL if updating the entity's DXF value failed                   |
;;|                                                                              |
;;| Example   :  (vle-entmod 62 entity 112) sets the colour index as 112         |
;;================================================================================
(if (not vle-entmod)
  (defun vle-entmod ( dxf ename value / olditem lst )
    (if (setq lst (entget ename))
      (if (setq olditem (assoc dxf lst))
        (if (not (equal value (cdr olditem)))
          (and (entmod (subst (cons dxf value) olditem lst)))
          t ;; new value is same as current value, do not update, to keep performance
        )
        (and (entmod (append lst (list (cons dxf value)))))
      )
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-entmod-m                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-entmod-m dxfData ename)                                                 |
;;|                                                                              |
;;| modifies the entity's property values for specified DXF group codes;         |
;;|                                                                              |
;;| Arguments : 'dxfData' list of (dxf . value) assoc items to be set            |
;;|           : 'ename'   the entity's ename                                     |
;;|                                                                              |
;;| Return    :  T   if the entity's values have been updated (or is identical)  |
;;|              NIL if updating the entity's DXF values failed                  |
;;|                                                                              |
;;| Example   :  (vle-entmod-m '((8 . "LayerX")(62 . 112)(39 . 2.0)) entity)     |
;;|              sets the layer to "LayerX"                                      |
;;|              sets the colour index as 112                                    |
;;|              sets the elevation as 2.0                                       |
;;================================================================================
(if (not vle-entmod-m)
  (defun vle-entmod-m ( dxfData ename / dxf olditem lst modified )
    (if (setq lst (entget ename))
      (progn
        (foreach item dxfData
          (if (not (equal (cdr item) (cdr (setq olditem (assoc (car item) lst)))))
            (setq modified t lst (if olditem
                                   (subst item olditem lst)
                                   (append lst (list item))
                                 )
            )
          )
        )
        (if modified (entmod lst))
        t
      )
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-getgeomextents                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-getgeomextents ename|selectionset|list-of-enames)                       |
;;|                                                                              |
;;| returns the bounding box (geometric extents) for given entity or entities    |
;;|                                                                              |
;;| Arguments : 'ename'         single entity name                               |
;;|           : 'selectionset'  set of entities                                  |
;;|           : 'list-of-ename' list of entity names                             |
;;|                                                                              |
;;| Return    :  '(minpoint maxpoint)                                            |
;;|              list of minimum (lower-left) and maximum (upper-right) points   |
;;|                                                                              |
;;| Example   :  (vle-getgeomextents (entlast))                                  |
;;|              returns  '((-1.0 2.0 0.0) (10.0 12.0 2.0))                      |
;;|                                                                              |
;;| Alias     :  vle-getboundingbox                                              |
;;================================================================================
(if (not vle-getgeomextents)
  (defun vle-getgeomextents ( arg / tp entities item ll ur
                                    xmin ymin zmin xmax ymax zmax res )
    (setq tp (type arg))
    (cond
      ((= tp 'ENAME)
       (vla-getboundingbox (vlax-ename->vla-object arg) 'll 'ur)
       (setq res (list (vlax-safearray->list ll) (vlax-safearray->list ur)))
      )
      ((= tp 'PICKSET) (setq entities (vle-selectionset->list arg)))
      ((= tp 'LIST)    (setq entities arg))
      (T (exit)) ;; improper argument
    )
    (if res
      res
      (progn
        (setq xmin  1.0E100 ymin xmin zmin xmin)
        (setq xmax -1.0E100 ymax xmax zmax xmax)
        (foreach item entities
          (setq ll nil ur nil)
          (vla-getboundingbox (vlax-ename->vla-object item) 'll 'ur)
          (if (and (= (type ll) 'SAFEARRAY) (= (type ur) 'SAFEARRAY))
            (progn
              (setq ll (vlax-safearray->list ll) ur (vlax-safearray->list ur))
              (if (< (car   ll) xmin) (setq xmin (car   ll)))
              (if (< (cadr  ll) ymin) (setq ymin (cadr  ll)))
              (if (< (caddr ll) zmin) (setq zmin (caddr ll)))
              (if (> (car   ur) xmax) (setq xmax (car   ur)))
              (if (> (cadr  ur) ymax) (setq ymax (cadr  ur)))
              (if (> (caddr ur) zmax) (setq zmax (caddr ur)))
            )
          )
        )
        (list (list xmin ymin zmin) (list xmax ymax zmax))
      )
    )
  )
)
(if (not vle-getboundingbox) (setq vle-getboundingbox vle-getgeomextents))

;;================================================================================
;;| FUNCTION : vle-dictobjname                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-dictobjname dictname itemname)                                          |
;;|                                                                              |
;;| verifies whether the dictionary 'dictname' contains an entry 'itemname';     |
;;| and returns the entity name of 'itemname'                                    |
;;|                                                                              |
;;| Arguments : 'dictname'  entity name or string of the dictionaty to search in |
;;|           : 'itemname'  the entry name to search for                         |
;;|                                                                              |
;;| Return    :  the name of the dictionary item 'itemname', if present;         |
;;|              NIL if the dictionary 'dictname' does not contain 'itemname'    |
;;|                                                                              |
;;| Example   :  (vle-dictobjname (namedobjdict) "ACAD_GROUP")                   |
;;|              returns the ename of the group dictionary, NIL otherwise        |
;;|                                                                              |
;;| Alias     :  dictobjname                                                     |
;;|                                                                              |
;;| Notes     :  replacement for (cdr (assoc -1 (dictsearch dictname itemname))) |
;;================================================================================
(if (not vle-dictobjname)
  (defun vle-dictobjname ( dictname itemname / lst en )
    (if (= (type dictname) 'STR)
      (setq dictname (__getDictEnameFromName dictname))
    )
    (if (and dictname (setq lst (dictsearch dictname itemname)))
      (setq en (cdr (assoc -1 lst)))
    )
    en
  )
)
(if (not dictobjname) (setq dictobjname vle-dictobjname))

;;================================================================================
;;| FUNCTION : vle-dictsearch                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-dictsearch dictname itemname)                                           |
;;|                                                                              |
;;| verifies whether the dictionary 'dictname' contains an entry 'itemname';     |
;;|                                                                              |
;;| Arguments : 'dictname'  entity name of the dictionary to search in           |
;;|           : 'itemname'  the entry name to search for                         |
;;|                                                                              |
;;| Return    :   T  if the dictionary 'dictname' contains 'itemname'            |
;;|              NIL if the dictionary 'dictname' does not contain 'itemname'    |
;;|                                                                              |
;;| Example   :  (vle-dictsearch (namedobjdict) "ACAD_GROUP")                    |
;;|              returns T if the group dictionary exists, NIL otherwise         |
;;|                                                                              |
;;| Notes     :  replacement for (/= (dictsearch dictname itemname) NIL)         |
;;================================================================================
(if (not vle-dictsearch)
  (defun vle-dictsearch ( dictname itemname )
    (/= (dictsearch dictname itemname) NIL)
  )
)

;;================================================================================
;;| FUNCTION : vle-tblsearch                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-tblsearch tblname tblitem)                                              |
;;|                                                                              |
;;| verifies whether the table 'tblname' contains an entry 'tblitem';            |
;;|                                                                              |
;;| Arguments : 'tblname'  table name (string) of the table to search in         |
;;|           : 'tblitem'  the entry name to search for                          |
;;|                                                                              |
;;| Return    :   T  if the table 'tblname' contains 'tblitem'                   |
;;|              NIL if the table 'tblname' does not contain 'tblitem'           |
;;|                                                                              |
;;| Example   :  (vle-tblsearch "LAYER" "11")                                    |
;;|              returns T if the layer table contains layer "11", NIL otherwise |
;;|                                                                              |
;;| Notes     :  replacement for                                                 |
;;|              (/= (tblsearch tblname tblitem) NIL)                            |
;;|              (/= (tblobjname tblname tblitem) NIL)                           |
;;================================================================================
(if (not vle-tblsearch)
  (defun vle-tblsearch ( tblname tblitem )
    (/= (tblobjname tblname tblitem) NIL)
  )
)

;;================================================================================
;;| FUNCTION : vle-table-list                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-table-list tablename asNames)                                           |
;;|                                                                              |
;;| scans the specified table and returns a list of all entries                  |
;;| (hidden or anonymous entries are not returned)                               |
;;|                                                                              |
;;| Arguments : 'tablename'  table name (string) to be scanned                   |
;;|             'asNames'    specifies whether item names are listed or the      |
;;|                          entity names of items; 'T' specifies item names     |
;;|                                                                              |
;;| Return  : list of table entries, as list of strings or entity names          |
;;|                                                                              |
;;| Example : (vle-table-list "LAYER" T)   => ("0" "1" "Lay_A" ... "Lay_X")      |
;;|           (vle-table-list "LAYER" nil) => (<Entity name> <Entity name> ... ) |
;;================================================================================
(if (not vle-table-list)
  (defun vle-table-list ( tblname asNames / res entry name )
    (setq entry (tblnext tblname t))
    (while (setq name (cdr (assoc 2 entry)))
      (setq res (cons (if asNames name (tblobjname tblname name)) res))
      (setq entry (tblnext tblname nil))
    )
    (reverse res)
  )
)

;;================================================================================
;;| FUNCTION : vle-table-list-all                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-table-list-all tablename asNames)                                       |
;;|                                                                              |
;;| scans the specified table and returns a list of all entries                  |
;;| (including hidden and anonymous entries)                                     |
;;|                                                                              |
;;| Arguments : 'tablename'  table name (string) to be scanned                   |
;;|             'asNames'    specifies whether item names are listed or the      |
;;|                          entity names of items; 'T' specifies item names     |
;;|                                                                              |
;;| Return  : list of table entries, as list of strings or entity names          |
;;|                                                                              |
;;| Example : (vle-table-list-all "BLOCK" T) ("*Model_Space" "*Paper_Space" ...) |
;;================================================================================
(if (not vle-table-list-all)
  (defun vle-table-list-all ( tblname asNames / cad doc collection item res entry )
    (setq tblname (strcase tblname))
    (setq cad (vlax-get-acad-object) doc (vla-get-ActiveDocument cad))
    (cond
      ((= tblname "BLOCK") (setq collection (vla-get-Blocks doc)))
      ((= tblname "LAYER") (setq collection (vla-get-Layers doc)))
      ((= tblname "LTYPE") (setq collection (vla-get-Linetypes doc)))
      ((= tblname "VIEW")  (setq collection (vla-get-Views doc)))
      ((= tblname "STYLE") (setq collection (vla-get-TextStyles doc)))
      ((= tblname "UCS")   (setq collection (vla-get-UserCoordinateSystems doc)))
      ((= tblname "APPID") (setq collection (vla-get-RegisteredApplications doc)))
      ((= tblname "DIMSTYLE") (setq collection (vla-get-DimStyles doc)))
      ((= tblname "VPORT") (setq collection (vla-get-Viewports doc)))
      (T (prompt (strcat "\n; error : no such table : " tblname)) (exit))
    )
    (if collection
      (vlax-for item collection
        (if asNames
          (setq res (cons (vla-get-Name item) res))
          (setq res (cons (vlax-vla-object->ename item) res))
        )
      )
    )
    (reverse res)
  )
)

;;================================================================================
;;| FUNCTION : vle-dictionary-list                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-dictionary-list dict subDict asNames)                                   |
;;|                                                                              |
;;| scans the specified dictionary or sub-dictionary and lists all entries       |
;;|                                                                              |
;;| Arguments : 'dict'     entity name or string of dictionary to be scanned     |
;;|             'subDict'  if not NIL, the name of the sub-dictionary to be      |
;;|                        scanned; if NIL, the 'dict' is scanned                |
;;|             'asNames'  specifies whether item keys are listed or the         |
;;|                        entity names of items; 'T' specifies item keys        |
;;|                                                                              |
;;| Return  : list of dictionary entries, as list of key strings or entity names |
;;|                                                                              |
;;| Example : (vle-dictionary-list (namedobjdict) nil T)                         |
;;|              => ("ACAD_COLOR" "ACAD_GROUP" "ACAD_LAYOUT" ...)                |
;;|           (vle-dictionary-list (namedobjdict) "ACAD_TABLESTYLE" T)           |
;;|              => ("Standard")                                                 |
;;|           (vle-dictionary-list (namedobjdict) "ACAD_TABLESTYLE" nil)         |
;;|              => (<Entity name: nnnnnnnn>)                                    |
;;|                                                                              |
;;| Notes   : depending on 'subDict', the function scans either the given        |
;;|           'dict' or the 'subDict' dictionary for its entries                 |
;;================================================================================
(if (not vle-dictionary-list)
  (defun vle-dictionary-list ( dict subDict asNames / res entry item )
    (if (= (type dict) 'STR)
      (setq dict (__getDictEnameFromName dict))
    )
    (if (and dict subDict)
      (setq dict (cdr (assoc -1 (dictsearch dict subDict))))
    )
    (if dict (setq entry (entget dict)))
    (foreach item entry
      (if (or (and asNames (= (car item) 3)) (and (not asNames) (= (car item) 350)))
        (setq res (cons (cdr item) res))
      )
    )
    (reverse res)
  )
)

;;================================================================================
;;| FUNCTION : vle-curve-getperimeter                                            |
;;|------------------------------------------------------------------------------|
;;| (vle-curve-getperimeter entity)                                              |
;;|                                                                              |
;;| returns the curve length (perimeter) for the specified entity                |
;;|                                                                              |
;;| Arguments :  'entity'  can be an ENAME or VLA-OBJECT                         |
;;|                                                                              |
;;| Return    :  'length' (perimeter) value of any 'curve' entity, or NIL in     |
;;|                       case of an (unexpected) error                          |
;;|                                                                              |
;;| Example   :  (vle-curve-getperimeter (entlast))                              |
;;|              returns 2.0 for a LINE with (0,0,0) - (2,0,0)                   |
;;|                                                                              |
;;| Alias     :  vlax-curve-getperimeter                                         |
;;================================================================================
(if (not vle-curve-getperimeter)
  (defun vle-curve-getperimeter ( ent / ep )
    (if (setq ep (vlax-curve-getendparam ent))
      (vlax-curve-getdistatparam ent ep)
      0.0
    )
  )
)
(if (not vlax-curve-getperimeter) (setq vlax-curve-getperimeter vle-curve-getperimeter))

;;================================================================================
;;| FUNCTION : vle-ename-valid                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-ename-valid ename)                                                      |
;;|                                                                              |
;;| verifies whether 'ename' is a valid entity name and not erased               |
;;|                                                                              |
;;| Arguments : 'ename'  entity name to be verified                              |
;;|                                                                              |
;;| Return    :   T  if 'ename' is valid and not erased                          |
;;|              NIL if 'ename' is either not an entity name or erased           |
;;|                                                                              |
;;| Example   :  (vle-ename-valid en) => T                                       |
;;|                                                                              |
;;| Notes     :  replacement for (if (entget ename) ...)                         |
;;================================================================================
(if (not vle-ename-valid)
  (defun vle-ename-valid ( en )
    (and (= (type en) 'ENAME) (not (vlax-erased-p en)))
  )
)


;;================================================================================
;;                      LISP Utility Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-alert                                                         |
;;|------------------------------------------------------------------------------|
;;| Author: Lee Mac, Copyright © 2012 - www.lee-mac.com                          |
;;|------------------------------------------------------------------------------|
;;| Original code: http://lee-mac.com/popup.html                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-alert title msg flags)                                                  |
;;|                                                                              |
;;| shows a message box, which can be customised in wide range (based on Windows |
;;| ::MessageBox() function)                                                     |
;;|                                                                              |
;;| Arguments : 'title' title for the message box (the caption string)           |
;;|           : 'msg'   the message to be displayed; will be word-wrapped        |
;;|           : 'flags' combination (addition) of integers specifying behaviour  |
;;|                                                                              |
;;|           : flags for button :                                               |
;;|                MB_OK                          0                              |
;;|                MB_OKCANCEL                    1                              |
;;|                MB_ABORTRETRYIGNORE            2                              |
;;|                MB_YESNOCANCEL                 3                              |
;;|                MB_YESNO                       4                              |
;;|                MB_RETRYCANCEL                 5                              |
;;|                MB_CANCELTRYCONTINUE           6                              |
;;|                MB_HELP                    16384                              |
;;|                                                                              |
;;|           : flags for icons :                                                |
;;|                MB_ICONHAND / MB_ICONSTOP            16                       |
;;|                MB_ICONQUESTION                      32                       |
;;|                MB_ICONEXCLAMATION                   48                       |
;;|                MB_ICONASTERISK /MB_ICONINFORMATION  64                       |
;;|                                                                              |
;;|           : flags for default button (for <return> input) :                  |
;;|                MB_DEFBUTTON1                  0                              |
;;|                MB_DEFBUTTON2                256                              |
;;|                MB_DEFBUTTON3                512                              |
;;|                MB_DEFBUTTON4                768                              |
;;|                                                                              |
;;|           : flags for behaviour :                                            |
;;|                MB_APPLMODAL                   0                              |
;;|                MB_SYSTEMMODAL              4096                              |
;;|                MB_TASKMODAL                8192                              |
;;|                                                                              |
;;|                MB_SETFOREGROUND           65536                              |
;;|                MB_DEFAULT_DESKTOP_ONLY   131072                              |
;;|                                                                              |
;;|                MB_TOPMOST                262144                              |
;;|                MB_RIGHT                  524288                              |
;;|                MB_RTLREADING            1048576                              |
;;|                                                                              |
;;| Return    :  number of button which was used to finish the dialogue          |
;;|              1   OK button                                                   |
;;|              2   Cancel button                                               |
;;|              3   Abort button                                                |
;;|              4   Retry button                                                |
;;|              5   Ignore button                                               |
;;|              6   Yes button                                                  |
;;|              7   No button                                                   |
;;|              10  Try Again button                                            |
;;|              11  Continue button                                             |
;;|                                                                              |
;;| Example   :  (vle-alert "My CAD App" "Dear Customer ...." (+ 4 32 4096))     |
;;|    will show Yes+No button, the question mark icon, as system modal dialogue |
;;================================================================================
(if (not vle-alert)
  (defun vle-alert ( title msg flags / wsh res )
    (vl-catch-all-apply
      (function
        (lambda ()
          (setq wsh (vlax-create-object "wscript.shell"))
          (setq res (vlax-invoke-method wsh 'popup msg 0 title flags))
        )
      )
    )
    (if wsh (vlax-release-object wsh))
    res
  )
)

;;================================================================================
;;| FUNCTION : vle-startapp                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-startapp cmd args mode)                                                 |
;;|                                                                              |
;;| runs the specified command, optionally with arguments, and optionally waits  |
;;| for the process to end (synchronous execution);                              |
;;| replaces (startapp), which does not wait for the process (asynchronous)      |
;;|                                                                              |
;;| Arguments : 'cmd'   the command / program to run (*.exe)                     |
;;|           : 'args'  optional arguments as string, or NIL if no arguments     |
;;|           : 'mode'  T specifies to wait for the process, NIL runs parallel   |
;;|                                                                              |
;;| Return    :  process ID if started parallel, or the program's return status  |
;;|                                                                              |
;;| Example   :  (vle-startapp "notepad.exe" "test.dat" t)                       |
;;================================================================================
(if (not vle-startapp)
  (defun vle-startapp ( cmd args mode / wsh res )
    (if args (setq cmd (strcat cmd " " args)))
    (if (setq wsh (vlax-get-or-create-object "WScript.Shell"))
      (setq res
        (vl-catch-all-apply
          'vlax-invoke-method (list wsh "Run" cmd 1 (if mode :vlax-true :vlax-false))
        )
      )
    )
    (if wsh (vlax-release-object wsh))
    (if (vl-catch-all-error-p res)
      -1
      res
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-selectionset->list                                            |
;;|------------------------------------------------------------------------------|
;;| (vle-selectionset->list selectionset)                                        |
;;|                                                                              |
;;| creates a normal list of entities from given selection set                   |
;;|                                                                              |
;;| Arguments : 'selectionset' the selection set to be returned as entity list   |
;;|                                                                              |
;;| Return    :  list of plain entity names, or NIL if selectionset is empty     |
;;|                                                                              |
;;| Example   :  (vle-selectionset->list ss) -> (<#Entity name> <#Entity name>)  |
;;================================================================================
(if (not vle-selectionset->list)
  (defun vle-selectionset->list ( ss / lst sslen )
    (if (and ss (= (type ss) 'PICKSET) (setq sslen (sslength ss)))
      (while (>= (setq sslen (1- sslen)) 0)
        (setq lst (cons (ssname ss sslen) lst))
      )
    )
    lst
  )
)

;;================================================================================
;;| FUNCTION : vle-collection->list                                              |
;;|------------------------------------------------------------------------------|
;;| (vle-collection->list collection)                                            |
;;|                                                                              |
;;| creates a normal list of items from given COM collection                     |
;;|                                                                              |
;;| Arguments : 'collection' the collection to get the items as normal list from |
;;|                                                                              |
;;| Return    :  list of items, or NIL if collection is empty                    |
;;|                                                                              |
;;| Example   :  (vle-collection->list (vla-get-layers (vlax-get-acad-object)))  |
;;|              returns (#<VLA-OBJECT IAcadLayer> #<VLA-OBJECT IAcadLayer> ...) |
;;================================================================================
(if (not vle-collection->list)
  (defun vle-collection->list ( coll / item lst )
    (vlax-for item coll
      (setq lst (cons item lst))
    )
    (reverse lst)
  )
)
(if (not vla-collection->list) (setq vla-collection->list vle-collection->list))

;;================================================================================
;;| FUNCTION : vle-safearray->list                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-safearray->list safearray)                                              |
;;|                                                                              |
;;| creates a normal list of items from given COM 'safearray' variable           |
;;|                                                                              |
;;| Arguments : 'safearray' the COM SAFEARRAY to get the list of items from      |
;;|                                                                              |
;;| Return    :  list of items, or NIL if 'safearray' is empty                   |
;;|                                                                              |
;;| Note : other than (vlax-safearray->list) it does not trigger an error for    |
;;|        an empty SAFEARRAY, but simply returns NIL (empty list)               |
;;|                                                                              |
;;================================================================================
(if (not vle-safearray->list)
  (defun vle-safearray->list ( sa / res )
    (if (/= (type sa) 'SAFEARRAY)
      (progn
        (if *error* (*error* "bad argument type, SAFEARRAY expected") (print "\n; error : bad argument type, SAFEARRAY expected"))
        (exit)
      )
    )
    (setq res (vl-catch-all-apply 'vlax-safearray->list (list sa)))
    (if (vl-catch-all-error-p res) (setq res NIL))
    res
  )
)

;;================================================================================
;;| FUNCTION : vle-fastcom                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-fastcom enableFlag)                                                     |
;;|                                                                              |
;;| enables or disables "Fast-COM" feature; Fast-COM bypasses the Windows COM    |
;;| interface for CAD-built-in COM objects, and therefore gives a significant    |
;;| performance advantage for (vla) and (vlax) functions                         |
;;|                                                                              |
;;| Arguments : 'enableFlag'  T enables, NIL disables the "Fast-COM" feature     |
;;|                                                                              |
;;| Return    :  currently active status                                         |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad, otherwise it is a No-Operation |
;;================================================================================
(if (not vle-fastcom)
  (defun vle-fastcom (enable) enable)
)
(if (not lisp$enablefastcom) (setq lisp$enablefastcom vle-fastcom))

;;================================================================================
;;| FUNCTION : vle-int64to32                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-int64to32 intVal)                                                       |
;;|                                                                              |
;;| truncates a given integer value to be in 32 bit range;                       |
;;| if input value is above 32 bit range (a 64 bit value) then this is truncated |
;;| to a 32 bit value, to match the behaviour of other CAD systems using 32 bit  |
;;| integers even in x64 builds                                                  |
;;|                                                                              |
;;| Arguments :  'intVal'  any integer value                                     |
;;|                                                                              |
;;| Return    :  always returns a 32 bit integer value                           |
;;|                                                                              |
;;| Example   :  (vle-int64to32 (* 10 268435456))                                |
;;|              returns -1610612736 instead of 2684354560                       |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad x64, otherwise it does nothing; |
;;|         as BricsCAD x64 allows 64 bit integers, there is a minor conflict    |
;;|         in compatibility with other CAD systems here;                        |
;;|         if a Lisp application needs that incorrect behaviour of other CAD    |
;;|         systems, then this function can help as workaround                   |
;;================================================================================
(if (not vle-int64to32)
  (defun vle-int64to32 ( num ) num)
)

;;================================================================================
;;| FUNCTION : vle-atoi32                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-atoi32 numstr)                                                          |
;;|                                                                              |
;;| returns the 32 bit integer value of input string;                            |
;;| if input value is above 32 bit range (a 64 bit number string) then this is   |
;;| truncated to a 32 bit value, to match the behaviour of other CAD systems     |
;;| using 32 bit integers even in x64 builds                                     |
;;|                                                                              |
;;| Arguments :  'numstr'  an integer number string                              |
;;|                                                                              |
;;| Return    :  always returns a 32 bit integer value                           |
;;|                                                                              |
;;| Example   :  (vle-atoi32 "2684354560")                                       |
;;|              returns -1610612736 instead of 2684354560                       |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad x64, otherwise it does nothing; |
;;|         as BricsCAD x64 allows 64 bit integers, there is a minor conflict    |
;;|         in compatibility with other CAD systems here;                        |
;;|         if a Lisp application needs that incorrect behaviour of other CAD    |
;;|         systems, then this function can help as workaround                   |
;;================================================================================
(if (not vle-atoi32)
  (defun vle-atoi32 ( numstr ) (atoi numstr))
)

;;================================================================================
;;| FUNCTION : vle-itoa32                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-itoa32 intVal)                                                          |
;;|                                                                              |
;;| returns the string representation of the 32 bit value of input number;       |
;;| if input value is above 32 bit range (a 64 bit number string) then this is   |
;;| truncated to a 32 bit value, to match the behaviour of other CAD systems     |
;;| using 32 bit integers even in x64 builds                                     |
;;|                                                                              |
;;| Arguments :  'intVal'  an integer number                                     |
;;|                                                                              |
;;| Return    :  returns the string of the 32 bit value of input number          |
;;|                                                                              |
;;| Example   :  (vle-itoa32 2684354560)                                         |
;;|              returns "-1610612736" instead of "2684354560"                   |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad x64, otherwise it does nothing; |
;;|         as BricsCAD x64 allows 64 bit integers, there is a minor conflict    |
;;|         in compatibility with other CAD systems here;                        |
;;|         if a Lisp application needs that incorrect behaviour of other CAD    |
;;|         systems, then this function can help as workaround                   |
;;================================================================================
(if (not vle-itoa32)
  (defun vle-itoa32 ( num ) (itoa num))
)

;;================================================================================
;;| FUNCTION : vle-aci2rgb                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-aci2rgb color)                                                          |
;;|                                                                              |
;;| returns the RGB values of specified ACI color index value as list            |
;;| of format (red green blue)                                                   |
;;|                                                                              |
;;| Arguments :  'color'  an integer number                                      |
;;|                                                                              |
;;| Return    :  returns the RGB values as list (red green blue)                 |
;;|                                                                              |
;;| Example   :  (vle-aci2rgb 1) returns (255 0 0)                               |
;;|              (vle-aci2rgb 5) returns (0 0 255)                               |
;;|              (vle-aci2rgb 128) returns (0 76 57)                             |
;;================================================================================
(if (not vle-aci2rgb)
  (defun vle-aci2rgb ( color / truecolor )
    (setq truecolor (vla-get-truecolor (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-put-colormethod truecolor acColorMethodByACI)
    (vla-put-colorindex truecolor color)
    (list (vla-get-red truecolor) (vla-get-green truecolor) (vla-get-blue truecolor))
  )
)

;;================================================================================
;;| FUNCTION : vle-rgb2aci                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-rgb2aci red green blue)                                                 |
;;|                                                                              |
;;| returns the closest ACI color value for specified RGB color                  |
;;|                                                                              |
;;| Arguments :  'red'    the RED   part of RGB color value                      |
;;|              'green'  the GREEN part of RGB color value                      |
;;|              'blue'   the BLUE  part of RGB color value                      |
;;|                                                                              |
;;| Return    :  returns the closest ACI color value as integer                  |
;;|                                                                              |
;;| Example   :  (vle-rgb2aci 255 0 0) returns 1                                 |
;;|              (vle-rgb2aci 0 0 255) returns 5                                 |
;;|              (vle-rgb2aci 0 76 57) returns 128                               |
;;|              (vle-rgb2aci 1 1 1)   returns 18                                |
;;================================================================================
(if (not vle-rgb2aci)
  (defun vle-rgb2aci ( red green blue / truecolor )
    (setq truecolor (vla-get-truecolor (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-put-colormethod truecolor acColorMethodByRGB)
    (vla-setrgb truecolor red green blue)
    (vla-get-colorindex truecolor)
  )
)

;;================================================================================
;;| FUNCTION : vle-showpromptmenu                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-showpromptmenu keywords)                                                |
;;|                                                                              |
;;| shows the PromptMenu, providing the options as in 'keywords'; the options    |
;;| keywords should follow the rules for (initget) keywords string; especially   |
;;| (but not only) useful in combination with (grread)                           |
;;|                                                                              |
;;| Arguments : 'keywords' list of keywords to be shown in the PromptMenu        |
;;|                                                                              |
;;| Return    :  NIL always                                                      |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad, otherwise it is a No-Operation |
;;================================================================================
(if (not vle-showpromptmenu)
  (defun vle-showpromptmenu (keywords) nil)
)

;;================================================================================
;;| FUNCTION : vle-hidepromptmenu                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-hidepromptmenu keywords)                                                |
;;|                                                                              |
;;| closes the PromptMenu, if displayed; otherwise this function does nothing    |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  NIL always                                                      |
;;|                                                                              |
;;| Notes : This is effective only with Bricscad, otherwise it is a No-Operation |
;;================================================================================
(if (not vle-hidepromptmenu)
  (defun vle-hidepromptmenu () nil)
)

;;================================================================================
;;| FUNCTION : vle-lispinstall                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-lispinstall)                                                            |
;;|                                                                              |
;;| returns the path (folder) where the Lisp engine is running from              |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  the folder where the Lisp engine is running from as string      |
;;|                                                                              |
;;================================================================================
(if (not vle-lispinstall)
  (defun vle-lispinstall ( / fname fpath )
    (if *isAcad* (setq fname "acad.exe"))
    (if *isBcad* (setq fname "bricscad.exe"))
    (setq fpath (findfile fname))
    (if (not fpath) (setq fpath (findfile "bricscad")))
    (if fpath
      (vl-filename-directory fpath)
      "" ; unknown system
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-lispversion                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-lispversion)                                                            |
;;|                                                                              |
;;| returns the version of the Lisp engine as string of a number                 |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  the version of the Lisp engine as string of a version number    |
;;|              and platform like "3.0 (x86)"                                   |
;;|                                                                              |
;;| Example   :  (vle-lispversion)                                               |
;;|              "5.0 (x86)" for x86 BricsCAD or "5.0 (x64)" for x64 BricsCAD    |
;;|              "2013 (x86)" for Acad 2013 x86, "2013 (x64)" for Acad 2013 x64  |
;;================================================================================
(if (not vle-lispversion)
  (defun vle-lispversion ( / version found )
    (setq version (strcase (ver)))
    (if (setq found (vl-string-search "VISUAL LISP" version))
      (setq version (substr version (+ found 13) 4))
      (if (setq found (vl-string-search "LISPEX : VERSION" version))
        (setq version (substr version (+ found 18) 3))
        (setq version "0.0 Unknown Lisp")
      )
    )
    (if (wcmatch (getvar "PLATFORM") "*(x86)*")
      (strcat version " (x86)")
      (strcat version " (x64)")
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-licenselevel                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-licenselevel)                                                           |
;;|                                                                              |
;;| returns the actual license level                                             |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  a list like ("CLASSIC" "PROFESSIONAL")                          |
;;|                                                                              |
;;| Example   :  (vle-licenselevel)                                              |
;;|              ("CLASSIC" "PROFESSIONAL")                                      |
;;================================================================================
(if (not vle-licenselevel)
  (defun vle-licenselevel () (list "CLASSIC" "PROFESSIONAL"))
)

;;================================================================================
;;| FUNCTION : vle-ping-alive                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-ping-alive)                                                             |
;;|                                                                              |
;;| sends a signal to Windows to indicate that the application (CAD system) is   |
;;| still "alive", to prevent the "Application does not respond ..." window      |
;;| state                                                                        |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  always T                                                        |
;;================================================================================
(if (not vle-ping-alive)
  (defun vle-ping-alive ( / cad )
    (setq cad (vlax-get-acad-object))
    (vla-put-WindowState cad (vla-get-WindowState cad))
    t
  )
)

;;================================================================================
;;| FUNCTION : vle-enableserverbusy                                              |
;;|------------------------------------------------------------------------------|
;;| (vle-enableserverbusy t|nil)                                                 |
;;|                                                                              |
;;| enables or disables the 'Server Busy ...' message box as shown by Windows,   |
;;| if a "server" application does not respond to the calling application within |
;;| 5...7 seconds;                                                               |
;;| usually it is a false-positive alert, most annoying and rather useless;      |
;;| AutoCAD seems to have that message disabled always                           |
;;|                                                                              |
;;| Arguments :  t   - to enable the 'Server Busy ...' message box               |
;;|              nil - to disable the 'Server Busy ...' message box              |
;;|                                                                              |
;;| Return    :  always T                                                        |
;;================================================================================
(if (not vle-enableserverbusy)
  (defun vle-enableserverbusy ( onOrOff / )
    t
  )
)

;;================================================================================
;;| FUNCTION : vle-edittextinplace                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-edittextinplace ename)                                                  |
;;|                                                                              |
;;| starts inplace-editing for several entity types;                             |
;;| works in 'modal' manner, (vle-edittextinplace) returns *after* editing       |
;;| is finished                                                                  |
;;|                                                                              |
;;| supported entity types :                                                     |
;;|     Text MText Dimension MLeader Attribute AttributeDefinition               |
;;|                                                                              |
;;| Arguments :  ename - classic entity name                                     |
;;|              NIL   - user is asked to select an editable entity              |
;;|                                                                              |
;;| Return    :  the new string value of the edited entity                       |
;;================================================================================
(if (not vle-edittextinplace)
  (defun vle-edittextinplace ( entity / tp vlaen res oldCmdEcho oldTextEd oldTextEdMode elist blkent )
    (if (not entity) (setq entity (car (nentsel))))
    (setq tp (type entity))
    (if (/= tp 'ENAME)
      (progn
        (prompt "\n; error : not an entity : ")(print entity) (exit)
      )
    )

    (setq vlaen (vlax-ename->vla-object entity))
    (setq tpname (vla-get-ObjectName vlaen))

    (setq oldCmdEcho (getvar "CMDECHO"))
    (setq oldTextEd (getvar "TEXTED"))
    (setq oldTextEdMode (getvar "TEXTEDITMODE"))
    (setvar "TEXTED" 0)
    (setvar "TEXTEDITMODE" 1)
    (setvar "CMDECHO" 1)

    (cond
      ((= tpname "AcDbText")
       (command "_textedit" entity)
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       (setq res (vla-get-TextString vlaen))
      )
      ((= tpname "AcDbMText")
       (command "_textedit" entity)
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       (setq res (vla-get-TextString vlaen))
      )
      ((= tpname "AcDbMLeader")
       (command "_textedit" entity)
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       (setq res (vla-get-TextString vlaen))
      )
      ((wcmatch tpname "AcDb*Dimension")
       (command "_textedit" entity)
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       ;; get the dimension text
       (setq blkent (tblobjname "BLOCK" (cdr (assoc 2 (entget entity)))))
       (while (and blkent (setq blkent (entnext blkent)))
         (setq vlaen (vlax-ename->vla-object blkent))
         (if (= (vla-get-ObjectName vlaen) "AcDbMText")
           (setq res (vla-get-TextString vlaen) blkent NIL)
         )
       )
      )
      ((= tpname "AcDbAttributeDefinition")
       (command "_textedit" entity)
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       (setq res (vla-get-TagString vlaen))
      )
      ((= tpname "AcDbAttribute")
       (command "_attipedit" (list entity (list 0 0 0)))
       (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
       (setq res (vla-get-TextString vlaen))
      )
    )

    (setvar "TEXTED" oldTextEd)
    (setvar "TEXTEDITMODE" oldTextEdMode)
    (setvar "CMDECHO" oldCmdEcho)

    res
  )
)


;;================================================================================
;;                  LISP Transaction/Display Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-start-transaction                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-start-transaction)                                                      |
;;|                                                                              |
;;| starts a database transaction for current drawing                            |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  T when transaction is active, NIL otherwise                     |
;;|                                                                              |
;;| Example   :  (vle-start-transaction) -> t : transaction is active            |
;;|                                         nil : transaction is not active      |
;;|                                                                              |
;;| Notes :                                                                      |
;;| with an active transaction, database and display updates are delayed until   |
;;| the transaction is finished - this can significantly improve performance     |
;;| when many entity and database modifications are done;                        |
;;| multiple / nested transactions are not supported - but it is gracefully      |
;;| tolerated, Lisp only keeps a single (global) transaction;                    |
;;| when outermost Lisp execution finishes, a pending / open transaction is      |
;;| automatically closed (i.e. when Lisp code errors)                            |
;;================================================================================
(if (not vle-start-transaction)
  (defun vle-start-transaction () nil)
)

;;================================================================================
;;| FUNCTION : vle-end-transaction                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-end-transaction)                                                        |
;;|                                                                              |
;;| finishes the active database transaction for current drawing                 |
;;|                                                                              |
;;| Arguments :  none                                                            |
;;|                                                                              |
;;| Return    :  T when transaction is active, NIL otherwise                     |
;;|                                                                              |
;;| Example   :  (vle-end-transaction) -> t : transaction is active              |
;;|                                       nil : transaction is not active        |
;;| Notes :                                                                      |
;;| see (vle-start-transaction)                                                  |
;;| when outermost Lisp execution finishes, a pending / open transaction is      |
;;| automatically closed (i.e. when Lisp code errors)                            |
;;================================================================================
(if (not vle-end-transaction)
  (defun vle-end-transaction () nil)
)

;;================================================================================
;;| FUNCTION : vle-displaypause                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-displaypause pauseDisplay)                                              |
;;|                                                                              |
;;| enables or disables display updates - when disabled, any update of the       |
;;| screen is suppressed until enabled again                                     |
;;|                                                                              |
;;| Arguments : 'pauseDisplay'  T    disables display updates                    |
;;|                             NIL  enables  display updates                    |
;;|                                                                              |
;;| Return    :  T   when display updates are disabled                           |
;;|              NIL when display updates are enabled                            |
;;|                                                                              |
;;| Note :                                                                       |
;;| this function can be nested - but each call with 'T' should be paired by a   |
;;| call with 'NIL'; when Lisp execution is finished, the display will be        |
;;| automatically enabled for safety                                             |
;;================================================================================
(if (not vle-displaypause)
  (defun vle-displaypause ( doSuppress ) nil)
)

;;================================================================================
;;| FUNCTION : vle-displayupdate                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-displayupdate)                                                          |
;;|                                                                              |
;;| triggers an immediate display update/refresh;                                |
;;| temporary graphics is not erased, other pending updates are processed        |
;;|                                                                              |
;;| Return :  T always                                                           |
;;================================================================================
(if (not vle-displayupdate)
  (defun vle-displayupdate () t) ;; nothing to do under AutoCAD
)


;;================================================================================
;;                  LISP String Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-string-split                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-string-split keys string)                                               |
;;|                                                                              |
;;| splits the given string 'string' into string-tokens, based on delimiter keys |
;;| as specified by 'keys'                                                       |
;;|                                                                              |
;;| Arguments : 'keys'    string containing all delimiter characters to be used  |
;;|             'string'  the string to be splitted into tokens                  |
;;|                                                                              |
;;| Return    :  list of tokens; if none of the <keys> characters is present in  |
;;|              string, the list contains only the original string (1 token)    |
;;|                                                                              |
;;| Example   : (vle-string-split ",;" "Sample, using different keys; voila")    |
;;|             will return '("Sample" " using different keys" " voila")         |
;;|                                                                              |
;;| Alias     :  vl-string-split, string-split                                   |
;;================================================================================
(if (not vle-string-split)
  (defun vle-string-split ( keys string / retlst idx len start keylst strlst )
    (setq idx 1 start 1 len (strlen string))
    (setq keylst (vl-string->list keys))
    (setq strlst (cons 0 (vl-string->list string)))
    (while (setq strlst (cdr strlst))
      (if (member (car strlst) keylst)
        (setq retlst (cons (substr string start (- idx start)) retlst)
              idx (1+ idx)
              start idx
        )
        (setq idx (1+ idx))
      )
    )
    (if retlst
      (reverse (cons (substr string start (1+ (- len start))) retlst))
      (list string)
    )
  )
)
(if (not vl-string-split) (setq vl-string-split vle-string-split))
(if (not string-split)    (setq string-split    vle-string-split))

;;================================================================================
;;| FUNCTION : vle-string-replace                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-string-replace newStr oldStr inStr)                                     |
;;|                                                                              |
;;| replaces all occurrences of 'oldStr' with 'newStr' in string 'inStr'         |
;;|                                                                              |
;;| Arguments : 'newStr'  new string replacing 'oldStr'                          |
;;|             'oldStr'  string to be replaced                                  |
;;|             'inStr'   target string for replacement                          |
;;|                                                                              |
;;| Return    : new string with all 'oldStr' replaced by 'newStr'                |
;;|                                                                              |
;;| Example   : (vle-string-replace "." "," "12,345,678")                        |
;;|             will return "12.345.678"                                         |
;;|                                                                              |
;;| Remarks   : both 'newStr' and 'oldStr' can have any length, and do not need  |
;;|             to be of same length                                             |
;;================================================================================
(if (not vle-string-replace)
  (defun vle-string-replace ( newStr oldStr inStr / lastStr )
    (while (/= lastStr inStr)
      (setq lastStr inStr)
      (setq inStr (vl-string-subst newStr oldStr inStr))
    )
    inStr
  )
)


;;================================================================================
;;                  LISP File Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-file->list                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-file->list filename commentchar)                                        |
;;|                                                                              |
;;| loads the text lines of specified file as a list of strings                  |
;;|                                                                              |
;;| Arguments : 'filename'     name of the file to be loaded                     |
;;|             'commentchar'  the "comment" character to ignore comment lines   |
;;|                                                                              |
;;| Return    :  list of file lines; or NIL, if the file is not found or empty   |
;;|                                                                              |
;;| Note :                                                                       |
;;| 'filename' is searched in all support pathes, if it does not contain a path; |
;;| 'commentchar' only used if not NIL; if NIL, all file lines are loaded        |
;;================================================================================
(if (not vle-file->list)
  (defun vle-file->list ( filename cchar / linelst fline fptr )
    (if (and (setq filename (findfile filename)) (setq fptr (open filename "r")))
      (while (setq fline (read-line fptr))
        (if (or (not cchar) (/= (substr fline 1 1) cchar))
          (setq linelst (cons fline linelst))
        )
      )
    )
    (if fptr (close fptr))
    (reverse linelst)
  )
)


;;================================================================================
;;                  LISP Math / Geometric Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-tan                                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-tan x)                                                                  |
;;|                                                                              |
;;| returns the tangent of 'x'                                                   |
;;|                                                                              |
;;| Arguments : 'x' any integer or double number (except PI*0.5 and multiples,   |
;;|                 where (cos x) is 0.0)                                        |
;;|                                                                              |
;;| Return    : the tangent of 'x'                                               |
;;|                                                                              |
;;| Example   : (tan 0.5) returns 0.546302                                       |
;;================================================================================
(if (not vle-tan)
  (defun vle-tan ( x / cosx )
    (if (/= (setq cosx (cos x)) 0.0)
      (/ (sin x) cosx)
      1.0E100
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-round                                                         |
;;|------------------------------------------------------------------------------|
;;| (vle-round x)                                                                |
;;|                                                                              |
;;| returns the nearest integer of 'x'                                           |
;;|                                                                              |
;;| Arguments : 'x' any integer or double number                                 |
;;|                                                                              |
;;| Return    : the nearest integer of 'x'                                       |
;;|                                                                              |
;;| Example   : (vle-round  13.2) =>  13                                         |
;;|             (vle-round -13.2) => -13                                         |
;;|             (vle-round  13.8) =>  14                                         |
;;|             (vle-round -13.8) => -14                                         |
;;================================================================================
(if (not vle-round)
  (defun vle-round ( x / )
    (if (minusp x)
      (fix (- x 0.5))
      (fix (+ x 0.5))
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-ceiling                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-ceiling x)                                                              |
;;|                                                                              |
;;| returns the smallest integer that is not less than x                         |
;;|                                                                              |
;;| Arguments : 'x' any integer or double number                                 |
;;|                                                                              |
;;| Return    : the smallest integer that is not less than x                     |
;;|                                                                              |
;;| Example   : (vle-ceiling  3.4) =>  4                                         |
;;|             (vle-ceiling -3.4) => -3                                         |
;;================================================================================
(if (not vle-ceiling)
  (defun vle-ceiling ( x / )
    (if (= (type x) 'INT)
      x
      (if (or (minusp x) (equal x (fix x)))
        (fix x)
        (fix (+ x 1))
      )
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-floor                                                         |
;;|------------------------------------------------------------------------------|
;;| (vle-floor x)                                                                |
;;|                                                                              |
;;| returns the largest integer that is not greater than x                       |
;;|                                                                              |
;;| Arguments : 'x' any integer or double number                                 |
;;|                                                                              |
;;| Return    : the largest integer that is not greater than x                   |
;;|                                                                              |
;;| Example   : (vle-floor  3.4) =>  3                                           |
;;|             (vle-floor -3.4) => -4                                           |
;;================================================================================
(if (not vle-floor)
  (defun vle-floor ( x / )
    (if (= (type x) 'INT)
      x
      (if (and (minusp x) (not (equal x (fix x))))
        (fix (- x 1))
        (fix x)
      )
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-roundto                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-roundto x digits)                                                       |
;;|                                                                              |
;;| returns the largest integer that is not greater than x                       |
;;|                                                                              |
;;| Arguments : 'x' any integer or double number                                 |
;;|             'digits' number of decimal places (precision)                    |
;;|                                                                              |
;;| Return    : double value of 'x', rounded to 'digits' places                  |
;;|                                                                              |
;;| Example   : (vle-roundto 1.23456789 1) => 1.2                                |
;;|             (vle-roundto 1.23456789 2) => 1.23                               |
;;|             (vle-roundto 1.23456789 3) => 1.235                              |
;;|             (vle-roundto 1.23456789 4) => 1.2346                             |
;;|             (vle-roundto 1.23456789 5) => 1.23457                            |
;;|             (vle-roundto 1.23456789 6) => 1.234568                           |
;;|             (vle-roundto 1.23456789 7) => 1.2345679                          |
;;|             (vle-roundto 1.23456789 8) => 1.23456789                         |
;;|                                                                              |
;;| Note : if input 'x' is an integer, it is converted to a double               |
;;================================================================================
(if (not vle-roundto)
  (defun vle-roundto ( x digits / )
    (atof (rtos x 2 digits))
  )
)


;;================================================================================
;;                  LISP List Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-append                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-append lst item)                                                        |
;;|                                                                              |
;;| append 'item' to the list 'lst'; 'item' can be any expression;               |
;;| replacement for (append lst (list item))                                     |
;;|                                                                              |
;;| Arguments : 'lst'  any valid list                                            |
;;|             'item' any valid item to be appended                             |
;;|                                                                              |
;;| Return    : the list 'lst' appended by 'item'                                |
;;|                                                                              |
;;| Example   : (vle-append '(1 2 3) '(4 5 6))                                   |
;;|             returns (1 2 3 (4 5 6))                                          |
;;|                                                                              |
;;| Notes     : other than (append) function, the item to be appended does not   |
;;|             need to be wrapped into extra (list ...) around !                |
;;================================================================================
(if (not vle-append)
  (defun vle-append (lst item )
    (append lst (list item))
  )
)

;;================================================================================
;;| FUNCTION : vle-nth0 vle-nth1 vle-nth2 vle-nth3 vle-nth4                      |
;;|            vle-nth5 vle-nth6 vle-nth7 vle-nth8 vle-nth9                      |
;;|------------------------------------------------------------------------------|
;;| (vle-nth<x> lst)                                                             |
;;|                                                                              |
;;| returns the item at index <x> of the list 'lst';                             |
;;| replacement for (nth <x> lst)                                                |
;;|                                                                              |
;;| Arguments : 'lst'     list of items                                          |
;;|                                                                              |
;;| Return    :  item at index <x> of the input list; index is 0-based !         |
;;|                                                                              |
;;| Example   :                                                                  |
;;| (vle-nth4 '(0 11 22 33 44 55 66 77 88 99) returns 44                         |
;;| (vle-nth8 '(0 11 22 33 44 55 66 77 88 99) returns 88                         |
;;================================================================================
(if (not vle-nth0) (defun vle-nth0 (lst) (if (vl-consp lst) (car lst)    (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth1) (defun vle-nth1 (lst) (if (vl-consp lst) (cadr lst)   (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth2) (defun vle-nth2 (lst) (if (vl-consp lst) (caddr lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth3) (defun vle-nth3 (lst) (if (vl-consp lst) (cadddr lst) (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth4) (defun vle-nth4 (lst) (if (vl-consp lst) (nth 4 lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth5) (defun vle-nth5 (lst) (if (vl-consp lst) (nth 5 lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth6) (defun vle-nth6 (lst) (if (vl-consp lst) (nth 6 lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth7) (defun vle-nth7 (lst) (if (vl-consp lst) (nth 7 lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth8) (defun vle-nth8 (lst) (if (vl-consp lst) (nth 8 lst)  (progn (princ "\n* error : not a list") (exit)))))
(if (not vle-nth9) (defun vle-nth9 (lst) (if (vl-consp lst) (nth 9 lst)  (progn (princ "\n* error : not a list") (exit)))))

;;================================================================================
;;| FUNCTION : vle-cdrassoc                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-cdrassoc key lst)                                                       |
;;|                                                                              |
;;| searches 'lst' list for a dotted-pair with key 'key' and returns its value;  |
;;| replacement for (cdr (assoc key lst))                                        |
;;|                                                                              |
;;| Arguments : 'key'  key value for the dotted pair value to search for         |
;;|             'lst'  list of dotted pairs                                      |
;;|                                                                              |
;;| Return    :  the value of dotted pair (key . value), if a dotted pair with   |
;;|              key 'key', if present in the list; NIL if not present           |
;;|                                                                              |
;;| Example   : (vle-cdrassoc 11 '((1 . "a")(2 . "b")(11 . "xx")(22 . "yy")))    |
;;|             returns "xx"                                                     |
;;|                                                                              |
;;| Alias     : vle-get-cdrassoc  vle-get-cassoc  vle-cassoc                     |
;;================================================================================
(if (not vle-cdrassoc)
  (defun vle-cdrassoc ( key lst ) (cdr (assoc key lst)))
)
(if (not vle-get-cdrassoc) (setq vle-get-cdrassoc vle-cdrassoc))
(if (not vle-cassoc) (setq vle-cassoc vle-cdrassoc))
(if (not vle-get-cassoc) (setq vle-get-cassoc vle-cdrassoc))

;;================================================================================
;;| FUNCTION : vle-cadrassoc                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-cadrassoc key lst)                                                      |
;;|                                                                              |
;;| searches 'lst' list for a dotted-pair with key 'key' and returns the (cadr)  |
;;| of its value; replacement for (cadr (assoc key lst))                         |
;;|                                                                              |
;;| Arguments : 'key'  key value for the dotted pair value to search for         |
;;|             'lst'  list of dotted pairs                                      |
;;|                                                                              |
;;| Return    :  the (cadr) of the value of dotted pair (key . value), if a      |
;;|              dotted pair with key 'key' is present in the list;              |
;;|              NIL if not present                                              |
;;|                                                                              |
;;| Example   : (vle-cadrassoc 11 '((1 (0 0 0)) (2 (1 1 1)) (11 (1 2 3))))       |
;;|             returns (1 2 3)                                                  |
;;|                                                                              |
;;| Alias     : vle-get-cadrassoc                                                |
;;================================================================================
(if (not vle-cadrassoc)
  (defun vle-cadrassoc ( key lst ) (cadr (assoc key lst)))
)
(if (not vle-get-cadrassoc) (setq vle-get-cadrassoc vle-cadrassoc))

;;================================================================================
;;| FUNCTION : vle-set-cdrassoc                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-set-cdrassoc key lst val)                                               |
;;|                                                                              |
;;| searches 'lst' list for dotted-pairs with key 'key' and sets the value of    |
;;| the dotted pairs (if found) to 'val';                                        |
;;|                                                                              |
;;| Arguments : 'key'  key value for the dotted pair value to search for         |
;;|             'lst'  list of dotted pairs                                      |
;;|             'val'  new value for dotted pairs with key 'key'                 |
;;|                                                                              |
;;| Return    : the input list with changed values for dotted pairs with 'key';  |
;;|             if there is no dotted-pair with 'key', 'lst' returns unchanged   |
;;|                                                                              |
;;| Example   : (setq lst '((1 . "a")(2 . "b")(1 . "a")(2 . "b")))               |
;;|             (setq lst (vle-set-cdrassoc 1 lst "A"))                          |
;;|             returns '((1 . "A")(2 . "b")(1 . "A")(2 . "b"))                  |
;;|                                                                              |
;;| Alias     : vle-set-cassoc                                                   |
;;|                                                                              |
;;| Remark    : *NOT* a general replacement for (subst new old lst) !!           |
;;|             but useful replacement for : (subst new (assoc key lst) lst)     |
;;================================================================================
(if (not vle-set-cdrassoc)
  (defun vle-set-cdrassoc ( key lst val / item newitem res )
    (setq newitem (cons key val))
    (while (setq item (car lst))
      (if (= (car item) key) (setq item newitem))
      (setq res (cons item res))
      (setq lst (cdr lst))
    )
    (reverse res)
  )
)
(if (not vle-set-cassoc) (setq vle-set-cassoc vle-set-cdrassoc))

;;================================================================================
;;| FUNCTION : vle-member                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-member item lst)                                                        |
;;|                                                                              |
;;| verifies whether list 'lst' contains the expression 'item'                   |
;;| replacement for (member item lst)                                            |
;;|                                                                              |
;;| Arguments : 'item'  expression to search for in 'lst'                        |
;;|             'lst'   normal Lisp list                                         |
;;|                                                                              |
;;| Return    : T if the expression 'item' is found in list 'lst';               |
;;|             NIL if not found                                                 |
;;|                                                                              |
;;| Alias     : vle-find                                                         |
;;================================================================================
(if (not vle-member)
  (defun vle-member ( obj lst )
    (or (member obj lst))
  )
)
(if (not vle-find) (setq vle-find vle-member))

;;================================================================================
;;| FUNCTION : vle-remove-first                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-remove-first item lst)                                                  |
;;|                                                                              |
;;| removes the first occurrence of 'item' from list 'lst'                       |
;;|                                                                              |
;;| Arguments : 'item'  object to remove from 'lst'                              |
;;|             'lst'   normal Lisp list                                         |
;;|                                                                              |
;;| Return    : list 'lst' without first occurrence of 'item', if found;         |
;;|             unchanged list 'lst' if not found                                |
;;|                                                                              |
;;| Example   : (vle-remove-first 123 '(1 2 123 4 5 123 6 7 8))                  |
;;|             returns '(1 2 4 5 123 6 7 8)                                     |
;;================================================================================
(if (not vle-remove-first)
  (defun vle-remove-first ( item lst / foundyet retlst )
    (while lst
      (if (or foundyet (not (setq foundyet (equal (car lst) item))))
        (setq retlst (cons (car lst) retlst))
      )
      (setq lst (cdr lst))
    )
    (reverse retlst)
  )
)

;;================================================================================
;;| FUNCTION : vle-remove-all                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-remove-all item lst)                                                    |
;;|                                                                              |
;;| removes all occurrences of 'item' from list 'lst' (like vl-remove)           |
;;|                                                                              |
;;| Arguments : 'item'  object to remove from 'lst'                              |
;;|             'lst'   normal Lisp list                                         |
;;|                                                                              |
;;| Return    : list 'lst' without all occurrences of 'item', if found;          |
;;|             unchanged list 'lst' if not found                                |
;;|                                                                              |
;;| Example   : (vle-remove 123 '(1 2 123 4 5 123 6 7 8))                        |
;;|             returns '(1 2 4 5 6 7 8)                                         |
;;================================================================================
(if (not vle-remove-all)
  (setq vle-remove-all vl-remove)
)

;;================================================================================
;;| FUNCTION : vle-remove-last                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-remove-last lst)                                                        |
;;|                                                                              |
;;| removes the last item from list 'lst';                                       |
;;| replacement for (reverse (cdr (reverse lst)))                                |
;;|                                                                              |
;;| Arguments : 'lst'   normal Lisp list                                         |
;;|                                                                              |
;;| Return    : list 'lst' without last item                                     |
;;================================================================================
(if (not vle-remove-last)
  (defun vle-remove-last (lst) (reverse (cdr (reverse lst))))
)

;;================================================================================
;;| FUNCTION : vle-remove-nth                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-remove-nth idx lst)                                                     |
;;|                                                                              |
;;| removes the object at index 'idx' from list 'lst' (index is 0-based)         |
;;|                                                                              |
;;| Arguments : 'idx'  index of the item to be removed; if negative, or 'lst'    |
;;|                    contains less items, nothing is removed                   |
;;|             'lst'  normal Lisp list                                          |
;;|                                                                              |
;;| Return    : list 'lst' without item at position 'idx'; if 'idx' is not       |
;;|             in the list, the unchanged list 'lst' is returned                |
;;|                                                                              |
;;| Alias     : vle-remove-idx                                                   |
;;|                                                                              |
;;| Example   : (vle-remove-nth 3 '(1 2 123 4 5 123 6 7 8))                      |
;;|             returns '(1 2 123 5 123 6 7 8)                                   |
;;================================================================================
(if (not vle-remove-nth)
  (defun vle-remove-nth ( idx lst / retlst )
    (if (and (>= idx 0) (< idx (length lst)))
      (progn
        (repeat idx (setq retlst (cons (car lst) retlst) lst (cdr lst)))
        (append (reverse retlst) (cdr lst))
      )
      lst  ;; unchanged
    )
  )
)
(if (not vle-remove-idx) (setq vle-remove-idx vle-remove-nth))

;;================================================================================
;;| FUNCTION : vle-search                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-search item lst asIdx)                                                  |
;;|                                                                              |
;;| searches for 'item' in list 'lst' and returns either the index of 'item' in  |
;;| 'lst', if 'asIdx' is non-NIL, or the list starting with 'item' if 'asIdx'    |
;;| is NIL, or NIL if 'item' is not contained in 'lst'                           |
;;|                                                                              |
;;| Arguments : 'item'   object to search for in 'lst'                           |
;;|             'lst'    list of items to search in                              |
;;|             'asIdx'  flag defining the type of result :                      |
;;|                      if NIL, the list starting with 'item' is returned       |
;;|                      if non-NIL, the index of 'item' in 'lst' is returned    |
;;|                                                                              |
;;| Return    : the index of 'item' in 'lst', or the sub-list starting with      |
;;|             'item', depending on 'asIdx' flag; index is always 0-based;      |
;;|             if 'item' is not contained in 'lst', NIL is returned             |
;;|                                                                              |
;;| Example   : (vle-search 11 '(1 2 3 11 22 33 ) nil) => '(11 22 33)            |
;;|             (vle-search 11 '(1 2 3 11 22 33 ) t)   => 3                      |
;;================================================================================
(if (not vle-search)
  (defun vle-search ( item lst asIdx / restlst )
    (setq restlst (member item lst))
    (if (or (not restlst) (not asIdx))
      restlst
      (- (length lst) (length restlst))
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-sublist                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-sublist lst startidx nritems)                                           |
;;|                                                                              |
;;| creates a sublist from given input list 'lst', starting with item at index   |
;;| 'startidx' and of maximum 'nritems' number of list items from 'lst'          |
;;|                                                                              |
;;| Arguments : 'lst'       list to extract a sublist from                       |
;;|             'startidx'  index of first item for sublist (0-based);           |
;;|                         if 'startidx' is < 0, 0 is used                      |
;;|             'nritems'   number of items to be copied from 'lst' list         |
;;|                         if 'nritems' is < 0, all items after 'startidx'      |
;;|                         are copied to result list                            |
;;|                                                                              |
;;| Return    : a sublist of 'lst' starting with index 'startidx' and containing |
;;|             'nritems' of input list 'lst';                                   |
;;|             if 'lst' has not enough items, only the items of 'lst' are       |
;;|             copied to result list, no NIL is appended                        |
;;|                                                                              |
;;| Example   : (vle-sublist '(1 2 3 4 5 6 7) 2 3)  => '(3 4 5)                  |
;;|             (vle-sublist '(1 2 3 4 5 6 7) 2 -1) => '(3 4 5 6 7)              |
;;|             (vle-sublist '(1 2 3 4 5 6 7) 2 10) => '(3 4 5 6 7)              |
;;================================================================================
(if (not vle-sublist)
  (defun vle-sublist ( lst startidx nritems / retlst )
    (if (<  startidx 0) (setq startidx 0))
    ;;--- position to first required index
    (while (> startidx 0) (setq lst (cdr lst) startidx (1- startidx)))
    ;;--- extract 'nritems' from list 'lst'
    (if (<= nritems 0)
      (setq retlst lst)
      (progn
        (while (and lst (> nritems 0))
          (setq retlst (cons (car lst) retlst) lst (cdr lst) nritems (1- nritems))
        )
        (setq retlst (reverse retlst))
      )
    )
    retlst
  )
)

;;================================================================================
;;| FUNCTION : vle-subst-nth                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-subst-nth lst idx val)                                                  |
;;|                                                                              |
;;| sets / replaces the item at index 'idx' in list 'lst' with specified new     |
;;| value 'val'                                                                  |
;;|                                                                              |
;;| Arguments : 'lst'  input list where the item at position 'idx' is to be set  |
;;|             'idx'  the 0-based index of the item to be replaced by new 'val' |
;;|             'val'  the new value to be set for the item                      |
;;|                                                                              |
;;| Return    : list 'lst' with changed item at position 'idx';                  |
;;|             if there is no item 'idx' in 'lst' the list remains unchanged;   |
;;|             if 'idx' is < 0 or greater than the list length, the unchanged   |
;;|             list is returned                                                 |
;;|                                                                              |
;;| Alias     : vle-replace                                                      |
;;|                                                                              |
;;| Example   : (vle-subst-nth '(1 2 3 4 5) 2 99)   => '(1 2 99 4 5)             |
;;|             (vle-subst-nth '(1 2 3 4 5) 10 99)  => '(1 2 3 4 5)              |
;;================================================================================
(if (not vle-subst-nth)
  (defun vle-subst-nth ( lst idx val / retlst )
    (if (and (>= idx 0) (< idx (length lst)))
      (progn
        (repeat idx (setq retlst (cons (car lst) retlst) lst (cdr lst)))
        (append (reverse (cons val retlst)) (cdr lst))
      )
      lst  ;; unchanged
    )
  )
)
(if (not vle-replace) (setq vle-replace vle-subst-nth))

;;================================================================================
;;| FUNCTION : vle-put-nth                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-put-nth lst idx val)                                                    |
;;|                                                                              |
;;| sets / replaces the item at index 'idx' in list 'lst' with specified new     |
;;| value 'val'; if 'idx' is larger then the list length, the list is filled     |
;;| with NIL items before 'val'                                                  |
;;|                                                                              |
;;| Arguments : 'lst'  input list where the item at position 'idx' is to be set  |
;;|             'idx'  the 0-based index of the item to be set by new 'val'      |
;;|             'val'  the new value to be set for the item at index 'idx'       |
;;|                                                                              |
;;| Return    : list 'lst' with item at position 'idx' set to 'val';             |
;;|             if 'idx' is < 0, the unchanged list is returned                  |
;;|             if 'idx' is greater than the list length, the list is filled     |
;;|             with NIL values before added item 'val'                          |
;;|                                                                              |
;;| Example   : (vle-put-nth '(1 2 3 4) 2 99) => '(1 2 99 4)                     |
;;|             (vle-put-nth '(1 2 3 4) 7 99) => '(1 2 3 4 nil nil nil 99)       |
;;================================================================================
(if (not vle-put-nth)
  (defun vle-put-nth ( lst idx val / retlst )
    (if (>= idx 0)
      (progn
        (repeat idx (setq retlst (cons (car lst) retlst) lst (cdr lst)))
        (append (reverse (cons val retlst)) (cdr lst))
      )
      lst  ;; unchanged
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-list-split                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-list-split lst item)                                                    |
;;|                                                                              |
;;| splits a list at a given item and returns both list parts                    |
;;|                                                                              |
;;| Arguments : 'lst'  list to be splitted at 'item'                             |
;;|             'item' the data where 'lst' is to be splitted                    |
;;|                                                                              |
;;| Return    : a list containing the "left" and the "right" sub-lists of input  |
;;|             list; 'item' is added to the "right" list, if present;           |
;;|             if 'item' is not present in 'lst', the "right" list part is nil  |
;;|                                                                              |
;;| Example   : (vle-list-split '(1 2 3 4 5) 3)  => '((1 2) (3 4 5))             |
;;|             (vle-list-split '(1 2 3 4 5) 8)  => '((1 2 3 4 5) nil)           |
;;|             (vle-list-split '(1 2 3 4 5) 1)  => '(NIL (1 2 3 4 5))           |
;;================================================================================
(if (not vle-list-split)
 (defun vle-list-split ( lst item / left entry stop )
  (while (and lst (not stop))
   (setq entry (car lst))
   (if (equal entry item)
    (setq stop t)
    (setq left (cons entry left) lst (cdr lst))
   )
  )
  (list (reverse left) lst)
 )
)

;;================================================================================
;;| FUNCTION : vle-list-union                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-list-union lst1 lst2)                                                   |
;;|                                                                              |
;;| merges 2 lists into 1 result list; all duplicates are removed                |
;;|                                                                              |
;;| Arguments : 'lst1'  first list to merge into result list                     |
;;|             'lst2'  second list to merge into result list                    |
;;|                                                                              |
;;| Return    : a list containing all unique items of 'lst1' and 'lst2';         |
;;|             result list does not contain any duplicates                      |
;;|                                                                              |
;;| Example   : (vle-list-union '(1 2 3 4) '(7 8 9))  => '(1 2 3 4 7 8 9)        |
;;|             (vle-list-union '(1 2 3 4) '(4 5 6))  => '(1 2 3 4 5 6)          |
;;|             (vle-list-union '(1 2 3 3) '(4 4 5))  => '(1 2 3 4 5)            |
;;================================================================================
(if (not vle-list-union)
 (defun vle-list-union ( lst1 lst2 / item result )
  (foreach item lst1
   (if (not (member item result))
    (setq result (cons item result))
   )
  )
  (foreach item lst2
   (if (not (member item result))
    (setq result (cons item result))
   )
  )
  (reverse result)
 )
)

;;================================================================================
;;| FUNCTION : vle-list-intersect                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-list-intersect lst1 lst2)                                               |
;;|                                                                              |
;;| creates a list which contains all those items contained in both input lists  |
;;|                                                                              |
;;| Arguments : 'lst1'  list to be verified against 'lst2'                       |
;;|             'lst2'  list to be verified against 'lst1'                       |
;;|                                                                              |
;;| Return    : a list containing all unique items, which are member in both     |
;;|             input lists                                                      |
;;|                                                                              |
;;| Example   : (vle-list-intersect '(1 2 3 4 5) '(3 4 5 6 7))  => '(3 4 5)      |
;;|             (vle-list-intersect '(1 2 3 4) '(4 5 6))  => '(4)                |
;;|             (vle-list-intersect '(1 2 3 4) '(5 6 7))  => nil                 |
;;================================================================================
(if (not vle-list-intersect)
 (defun vle-list-intersect ( lst1 lst2 / item result )
  (foreach item lst1
   (if (and (not (member item result)) (member item lst2))
    (setq result (cons item result))
   )
  )
  (reverse result)
 )
)

;;================================================================================
;;| FUNCTION : vle-list-subtract                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-list-subtract lst1 lst2)                                                |
;;|                                                                              |
;;| creates a list which contains all items of 'lst1' without items of 'lst2'    |
;;|                                                                              |
;;| Arguments : 'lst1'  list "subtract" the items of 'lst2' from                 |
;;|             'lst2'  list to be "subtracted" from 'lst1'                      |
;;|                                                                              |
;;| Return    : a list containing all items of 'lst1' without items of 'lst2'    |
;;|                                                                              |
;;| Example   : (vle-list-subtract '(1 2 3 4 5) '(7 3 6))  => '(1 2 4 5)         |
;;|             (vle-list-subtract '(1 2 3 4 5) '(7 8 9))  => '(1 2 3 4 5)       |
;;|             (vle-list-subtract '(1 2 3 3 4) '(7 3 6))  => '(1 2 4)           |
;;================================================================================
(if (not vle-list-subtract)
 (defun vle-list-subtract ( lst1 lst2 / item result )
  (foreach item lst1
   (if (not (member item lst2))
    (setq result (cons item result))
   )
  )
  (reverse result)
 )
)

;;================================================================================
;;| FUNCTION : vle-list-diff                                                     |
;;|------------------------------------------------------------------------------|
;;| (vle-list-diff lst1 lst2)                                                    |
;;|                                                                              |
;;| returns the "list difference" of 2 lists; it contains all the items, which   |
;;| are member of either 'lst1' or 'lst2', but not member of both lists          |
;;|                                                                              |
;;| Arguments : 'lst1'  list to be compared against 'lst2'                       |
;;|             'lst2'  list to be compared against 'lst1'                       |
;;|                                                                              |
;;| Return    : a list containing all items which are unique for their owner     |
;;|             lists; in other words, which are not member of both lists;       |
;;|                                                                              |
;;| Example   : (vle-list-diff '(1 2 3 3 4) '(3 4 5 6))  => '(1 2 5 6)           |
;;|             (vle-list-diff '(1 2 3 3 4) '(5 6 7 8))  => '(1 2 3 3 4 5 6 7 8) |
;;|             (vle-list-diff '(1 2 3 3 4) nil)  => '(1 2 3 3 4)                |
;;================================================================================
(if (not vle-list-diff)
 (defun vle-list-diff ( lst1 lst2 / item result )
  (foreach item lst1
   (if (not (member item lst2))
    (setq result (cons item result))
   )
  )
  (foreach item lst2
   (if (not (member item lst1))
    (setq result (cons item result))
   )
  )
  (reverse result)
 )
)

;;================================================================================
;;| FUNCTION : vle-list-massoc                                                   |
;;|------------------------------------------------------------------------------|
;;| (vle-list-massoc key lst)                                                    |
;;|                                                                              |
;;| returns a list of all values using same 'key' in assoc-list 'lst'            |
;;|                                                                              |
;;| Arguments : 'key'  key to be used to parse the assoc list                    |
;;|             'lst'  assoc list, may contain multiple items with same key      |
;;|                                                                              |
;;| Return    : a list containing all cdr values of assoc items with key 'key';  |
;;|             the list may contain multiple assoc items with key 'key';        |
;;|             returned list contains all values in original sequence           |
;;|                                                                              |
;;| Example   : (setq lst '((1 . "a")(2 . "b")(1 . 11)(2 . 22)))                 |
;;|             (vle-list-massoc 1 lst) => ("a" 11)                              |
;;|             (vle-list-massoc 2 lst) => ("b" 22)                              |
;;================================================================================
(if (not vle-list-massoc)
  (defun vle-list-massoc ( key lst )
    (mapcar 'cdr (vl-remove-if-not '(lambda (item) (eq key (car item))) lst))
  )
)


;;================================================================================
;;                  LISP DataType Functions
;;================================================================================

;;================================================================================
;;| FUNCTION : vle-stringp                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-stringp obj)                                                            |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of STRING type             |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a string object                                |
;;|             NIL - if 'obj' is not a string object                            |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'STR) and similar                     |
;;================================================================================
(if (not vle-stringp)
  (defun vle-stringp ( obj )
    (= (type obj) 'STR)
  )
)

;;================================================================================
;;| FUNCTION : vle-numberp                                                       |
;;|------------------------------------------------------------------------------|
;;| (vle-numberp obj)                                                            |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of any number type         |
;;| (int double)                                                                 |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a number object                                |
;;|             NIL - if 'obj' is not a number object                            |
;;|                                                                              |
;;| Note : identical to (numberp), implemented for completeness                  |
;;================================================================================
(if (not vle-numberp)
  (defun vle-numberp ( obj )
    (numberp obj)
  )
)

;;================================================================================
;;| FUNCTION : vle-realp                                                         |
;;|------------------------------------------------------------------------------|
;;| (vle-realp obj)                                                              |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of REAL (double) type      |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a REAL (double) object                         |
;;|             NIL - if 'obj' is not a REAL (double) object                     |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'REAL) and similar                    |
;;================================================================================
(if (not vle-realp)
  (defun vle-realp ( obj )
    (= (type obj) 'REAL)
  )
)

;;================================================================================
;;| FUNCTION : vle-integerp                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-integerp obj)                                                           |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of integer type            |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a integer object                               |
;;|             NIL - if 'obj' is not a integer object                           |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'INT) and similar                     |
;;================================================================================
(if (not vle-integerp)
  (defun vle-integerp ( obj )
    (= (type obj) 'INT)
  )
)

;;================================================================================
;;| FUNCTION : vle-filep                                                         |
;;|------------------------------------------------------------------------------|
;;| (vle-filep obj)                                                              |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of FILE type               |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a FILE object                                  |
;;|             NIL - if 'obj' is not a FILE object                              |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'FILE) and similar                    |
;;================================================================================
(if (not vle-filep)
  (defun vle-filep ( obj )
    (= (type obj) 'FILE)
  )
)

;;================================================================================
;;| FUNCTION : vle-enamep                                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-enamep obj)                                                             |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of ENAME type              |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a ENAME object                                 |
;;|             NIL - if 'obj' is not a ENAME object                             |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'ENAME) and similar                   |
;;================================================================================
(if (not vle-enamep)
  (defun vle-enamep ( obj )
    (= (type obj) 'ENAME)
  )
)

;;================================================================================
;;| FUNCTION : vle-picksetp                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-picksetp obj)                                                           |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of PICKSET type            |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a PICKSET object                               |
;;|             NIL - if 'obj' is not a PICKSET object                           |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'PICKSET) and similar                 |
;;================================================================================
(if (not vle-picksetp)
  (defun vle-picksetp ( obj )
    (= (type obj) 'PICKSET)
  )
)

;;================================================================================
;;| FUNCTION : vle-vlaobjectp                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-vlaobjectp obj)                                                         |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of VLA-OBJECT type         |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a VLA-OBJECT object                            |
;;|             NIL - if 'obj' is not a VLA-OBJECT object                        |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'VLA-OBJECT) and similar              |
;;================================================================================
(if (not vle-vlaobjectp)
  (defun vle-vlaobjectp ( obj )
    (= (type obj) 'VLA-OBJECT)
  )
)

;;================================================================================
;;| FUNCTION : vle-variantp                                                      |
;;|------------------------------------------------------------------------------|
;;| (vle-variantp obj)                                                           |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of VARIANT type            |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a VARIANT object                               |
;;|             NIL - if 'obj' is not a VARIANT object                           |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'VARIANT) and similar                 |
;;================================================================================
(if (not vle-variantp)
  (defun vle-variantp ( obj )
    (= (type obj) 'VARIANT)
  )
)

;;================================================================================
;;| FUNCTION : vle-safearrayp                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-safearrayp obj)                                                         |
;;|                                                                              |
;;| predicator function to determine whether 'obj' is of SAFEARRAY type          |
;;|                                                                              |
;;| Arguments : 'obj'  any Lisp item to be verified                              |
;;|                                                                              |
;;| Return    : T   - if 'obj' is a SAFEARRAY object                             |
;;|             NIL - if 'obj' is not a SAFEARRAY object                         |
;;|                                                                              |
;;| Note : replacement for : (= (type obj) 'SAFEARRAY) and similar               |
;;================================================================================
(if (not vle-safearrayp)
  (defun vle-safearrayp ( obj )
    (= (type obj) 'SAFEARRAY)
  )
)


;;================================================================================
;;                  LISP Vector Functions
;;================================================================================

;; tolerance used by vector functions
(setq vle_g_vecTol 0.0000000001)  ;; 1e-10


;;================================================================================
;;| FUNCTION : vle-vector-gettolerance                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-gettolerance)                                                    |
;;|                                                                              |
;;| returns the current tolerance used in vector functions                       |
;;|                                                                              |
;;| Arguments : none                                                             |
;;|                                                                              |
;;| Return    : double                                                           |
;;|                                                                              |
;;| Note : please do not modify 'vle_g_vecTol' directly, use this function       |
;;================================================================================
(if (not vle-vector-gettolerance)
  (defun vle-vector-gettolerance () vle_g_vecTol)
)

;;================================================================================
;;| FUNCTION : vle-vector-settolerance                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-settolerance tol)                                                |
;;|                                                                              |
;;| sets the current tolerance used in vector functions                          |
;;|                                                                              |
;;| Arguments : 'tol'  double, the new tolerance (usually 1e-06 ... 1e-12)       |
;;|                                                                              |
;;| Return    : always t                                                         |
;;|                                                                              |
;;| Note : please do not modify 'vle_g_vecTol' directly, use this function       |
;;================================================================================
(if (not vle-vector-settolerance)
  (defun vle-vector-settolerance ( tol )
    (if (not (numberp tol)) (exit))
    (setq vle_g_vecTol tol)
    t
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-get                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-get fromPt toPt)                                                 |
;;|                                                                              |
;;| returns the vector [fromPt -> toPt] as 3d list                               |
;;|                                                                              |
;;| Arguments : 'fromPt'  a 2d or 3d point list                                  |
;;|             'toPt'    a 2d or 3d point list                                  |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) always a 3d vector list                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-get)
  (defun vle-vector-get ( fromPt toPt / fromZ toZ )
    (if (or (/= (type fromPt) 'LIST) (not (car fromPt)) (not (cadr fromPt))) (exit))
    (if (or (/= (type toPt)   'LIST) (not (car toPt))   (not (cadr toPt)))   (exit))

    (setq fromZ (caddr fromPt) toZ (caddr toPt))
    (if (not fromZ) (setq fromZ 0.0))
    (if (not toZ)   (setq toZ   0.0))

    (list (- (car toPt) (car fromPt)) (- (cadr toPt) (cadr fromPt)) (- toZ fromZ))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-add                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-add vec1 vec2)                                                   |
;;|                                                                              |
;;| returns the addition of vectors 'vec1' and 'vec2'                            |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) always a 3d vector list                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-add)
  (defun vle-vector-add ( vec1 vec2 / z1 z2 )
    (if (or (/= (type vec1) 'LIST) (not (car vec1)) (not (cadr vec1))) (exit))
    (if (or (/= (type vec2) 'LIST) (not (car vec2)) (not (cadr vec2))) (exit))

    (setq z1 (caddr vec1) z2 (caddr vec2))
    (if (not z1) (setq z1 0.0))
    (if (not z2) (setq z2 0.0))

    (list (+ (car vec1) (car vec2)) (+ (cadr vec1) (cadr vec2)) (+ z1 z2))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-sub                                                    |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-sub vec1 vec2)                                                   |
;;|                                                                              |
;;| returns the subraction of vector 'vec2' from 'vec1'                          |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) always a 3d vector list                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-sub)
  (defun vle-vector-sub ( vec1 vec2 / z1 z2 )
    (if (or (/= (type vec1) 'LIST) (not (car vec1)) (not (cadr vec1))) (exit))
    (if (or (/= (type vec2) 'LIST) (not (car vec2)) (not (cadr vec2))) (exit))

    (setq z1 (caddr vec1) z2 (caddr vec2))
    (if (not z1) (setq z1 0.0))
    (if (not z2) (setq z2 0.0))

    (list (- (car vec1) (car vec2)) (- (cadr vec1) (cadr vec2)) (- z1 z2))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-scale                                                  |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-scale vec factor)                                                |
;;|                                                                              |
;;| returns the vector 'vec' scaled/multiplied by 'factor'                       |
;;|                                                                              |
;;| Arguments : 'vec'     a 2d or 3d vector list                                 |
;;|             'factor'  integer or double number                               |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) always a 3d vector list                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-scale)
  (defun vle-vector-scale ( vec factor / vz )
    (if (or (/= (type vec) 'LIST) (not (car vec)) (not (cadr vec))) (exit))
    (if (and (/= (type factor) 'INT) (/= (type factor) 'REAL)) (exit))

    (setq vz (caddr vec))
    (if (not vz) (setq vz 0.0))

    (list (* (car vec) factor) (* (cadr vec) factor) (* vz factor))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-length                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-length vec)                                                      |
;;|                                                                              |
;;| returns the 3D length of the vector                                          |
;;|                                                                              |
;;| Arguments : 'vec' a 2d or 3d vector list                                     |
;;|                                                                              |
;;| Return    : double, the length of the vector in 3D                           |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-length)
  (defun vle-vector-length ( vec / vX vY vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (distance '(0 0 0) (list vX vY vZ))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-length2d                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-length2d vec)                                                    |
;;|                                                                              |
;;| returns the 2D length of the vector, in XY plane                             |
;;|                                                                              |
;;| Arguments : 'vec' a 2d or 3d vector list                                     |
;;|                                                                              |
;;| Return    : double, the length of the vector in 2D, in XY plane              |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-length2d)
  (defun vle-vector-length2d ( vec / vX vY )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (sqrt (+ (* vX vX) (* vY vY)))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-length2dxz                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-length2dxz vec)                                                  |
;;|                                                                              |
;;| returns the 2D length of the vector, in XZ plane                             |
;;|                                                                              |
;;| Arguments : 'vec' a 2d or 3d vector list                                     |
;;|                                                                              |
;;| Return    : double, the length of the vector in 2D, in XZ plane              |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-length2dxz)
  (defun vle-vector-length2dxz ( vec / vX vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vZ (caddr vec))
    (if (not vX) (exit))
    (if (not vZ) (setq vZ 0.0))

    (sqrt (+ (* vX vX) (* vZ vZ)))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-length2dyz                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-length2dyz vec)                                                  |
;;|                                                                              |
;;| returns the 2D length of the vector, in YZ plane                             |
;;|                                                                              |
;;| Arguments : 'vec' a 2d or 3d vector list                                     |
;;|                                                                              |
;;| Return    : double, the length of the vector in 2D, in YZ plane              |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-length2dyz)
  (defun vle-vector-length2dyz ( vec / vY vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vY (cadr vec) vZ (caddr vec))
    (if (not vY) (exit))
    (if (not vZ) (setq vZ 0.0))

    (sqrt (+ (* vY vY) (* vZ vZ)))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-normalise                                              |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-normalise vec)                                                   |
;;|                                                                              |
;;| returns the normalised vector (length is 1.0)                                |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) normalised 3d vector                            |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-normalise)
  (defun vle-vector-normalise ( vec / vX vY vZ len )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (setq len (sqrt (+ (* vX vX) (* vY vY) (* vZ vZ))))
    (if (equal len 0.0 vle_g_vecTol) (setq len 1.0))
    (setq len (/ 1.0 len))

    (list (* vX len) (* vY len) (* vZ len))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isunitlength                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isunitlength vec)                                                |
;;|                                                                              |
;;| returns whether 'vec' has a length of 1.0 (1 unit length, tolerance 1e-10)   |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isunitlength)
  (defun vle-vector-isunitlength ( vec / vX vY vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (equal (distance '(0 0 0) (list vX vY vZ)) 1.0 vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-iszerolength                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-iszerolength vec)                                                |
;;|                                                                              |
;;| returns whether 'vec' has a length of 0.0 (zero length, tolerance 1e-10)     |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-iszerolength)
  (defun vle-vector-iszerolength ( vec / vX vY vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (equal (list vX vY vZ) '(0 0 0) vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isequal                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isequal vec1 vec2)                                               |
;;|                                                                              |
;;| returns whether 'vec1' is equal to 'vec2' (tolerance 1e-10)                  |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isequal)
  (defun vle-vector-isequal ( vec1 vec2 / )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))
    (equal vec1 vec2 vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isxaxis                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isxaxis vec)                                                     |
;;|                                                                              |
;;| returns whether 'vec' is equal to X-axis vector (1 0 0) (tolerance 1e-10)    |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isxaxis)
  (defun vle-vector-isxaxis ( vec / )
    (if (/= (type vec) 'LIST) (exit))
    (equal vec '(1.0 0.0 0.0) vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isyaxis                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isyaxis vec)                                                     |
;;|                                                                              |
;;| returns whether 'vec' is equal to Y-axis vector (0 1 0) (tolerance 1e-10)    |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isyaxis)
  (defun vle-vector-isyaxis ( vec / )
    (if (/= (type vec) 'LIST) (exit))
    (equal vec '(0.0 1.0 0.0) vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-iszaxis                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-iszaxis vec)                                                     |
;;|                                                                              |
;;| returns whether 'vec' is equal to Z-axis vector (0 0 1) (tolerance 1e-10)    |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-iszaxis)
  (defun vle-vector-iszaxis ( vec / )
    (if (/= (type vec) 'LIST) (exit))
    (equal vec '(0.0 0.0 1.0) vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-negate                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-negate vec)                                                      |
;;|                                                                              |
;;| returns the negated (inverted) vector of 'vec'                               |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-negate)
  (defun vle-vector-negate ( vec / vX vY vZ )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (list (* -1.0 vX) (* -1.0 vY) (* -1.0 vZ))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-crossproduct                                           |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-crossproduct vec1 vec2)                                          |
;;|                                                                              |
;;| returns the cross-product vector of 'vec1' and 'vec2'                        |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) cross-prodcut 3D vector                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-crossproduct)
  (defun vle-vector-crossproduct ( vec1 vec2 / vX1 vY1 vZ1 vX2 vY2 vZ2 )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))

    (setq vX1 (car vec1) vY1 (cadr vec1))
    (setq vX2 (car vec2) vY2 (cadr vec2))
    (if (or (not vX1) (not vY1) (not vX2) (not vY2)) (exit))

    (setq vZ1 (caddr vec1) vZ2 (caddr vec2))
    (if (not vZ1) (setq vZ1 0.0))
    (if (not vZ2) (setq vZ2 0.0))

    (list (- (* vY1 vZ2) (* vZ1 vY2))
          (- (* vZ1 vX2) (* vX1 vZ2))
          (- (* vX1 vY2) (* vY1 vX2))
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-dotproduct                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-dotproduct vec1 vec2)                                            |
;;|                                                                              |
;;| returns the dot-product vector of 'vec1' and 'vec2'                          |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : double, the dot-prodcut                                          |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-dotproduct)
  (defun vle-vector-dotproduct ( vec1 vec2 / vX1 vY1 vZ1 vX2 vY2 vZ2 )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))

    (setq vX1 (car vec1) vY1 (cadr vec1))
    (setq vX2 (car vec2) vY2 (cadr vec2))
    (if (or (not vX1) (not vY1) (not vX2) (not vY2)) (exit))

    (setq vZ1 (caddr vec1) vZ2 (caddr vec2))
    (if (not vZ1) (setq vZ1 0.0))
    (if (not vZ2) (setq vZ2 0.0))

    (+ (* vX1 vX2)
       (* vY1 vY2)
       (* vZ1 vZ2)
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isparallel                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isparallel vec1 vec2)                                            |
;;|                                                                              |
;;| returns whether the vectors 'vec1' and 'vec2' are parallel or not            |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isparallel)
  (defun vle-vector-isparallel ( vec1 vec2 / vX1 vY1 vZ1 vX2 vY2 vZ2 )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))

    (setq vX1 (car vec1) vY1 (cadr vec1))
    (setq vX2 (car vec2) vY2 (cadr vec2))
    (if (or (not vX1) (not vY1) (not vX2) (not vY2)) (exit))

    (setq vZ1 (caddr vec1) vZ2 (caddr vec2))
    (if (not vZ1) (setq vZ1 0.0))
    (if (not vZ2) (setq vZ2 0.0))

    ;; cross-product is <0 0 0> if parallel
    (and
      (or (not (equal vX1 0.0 vle_g_vecTol)) (not (equal vY1 0.0 vle_g_vecTol)) (not (equal vZ1 0.0 vle_g_vecTol)))
      (or (not (equal vX2 0.0 vle_g_vecTol)) (not (equal vY2 0.0 vle_g_vecTol)) (not (equal vZ2 0.0 vle_g_vecTol)))
      (equal
         (list (- (* vY1 vZ2) (* vZ1 vY2))
               (- (* vZ1 vX2) (* vX1 vZ2))
               (- (* vX1 vY2) (* vY1 vX2))
         )
         '(0 0 0)
         vle_g_vecTol
      )
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-isperpendicular                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-isperpendicular vec1 vec2)                                       |
;;|                                                                              |
;;| returns whether the vectors 'vec1' and 'vec2' are orthogonal to each other   |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-isperpendicular)
  (defun vle-vector-isperpendicular ( vec1 vec2 / vX1 vY1 vZ1 vX2 vY2 vZ2 )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))

    (setq vX1 (car vec1) vY1 (cadr vec1))
    (setq vX2 (car vec2) vY2 (cadr vec2))
    (if (or (not vX1) (not vY1) (not vX2) (not vY2)) (exit))

    (setq vZ1 (caddr vec1) vZ2 (caddr vec2))
    (if (not vZ1) (setq vZ1 0.0))
    (if (not vZ2) (setq vZ2 0.0))

    ;; dot-product is 0 if orthogonal/perpendicular
    (equal (+ (* vX1 vX2) (* vY1 vY2) (* vZ1 vZ2)) 0.0 vle_g_vecTol)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-iscodirectional                                        |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-iscodirectional vec1 vec2)                                       |
;;|                                                                              |
;;| returns whether the vectors 'vec1' and 'vec2' are co-directional             |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : T or NIL                                                         |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-iscodirectional)
  (defun vle-vector-iscodirectional ( vec1 vec2 / vX1 vY1 vZ1 vX2 vY2 vZ2 len1 len2 )
    (if (or (/= (type vec1) 'LIST) (/= (type vec2) 'LIST)) (exit))

    (setq vX1 (car vec1) vY1 (cadr vec1))
    (setq vX2 (car vec2) vY2 (cadr vec2))
    (if (or (not vX1) (not vY1) (not vX2) (not vY2)) (exit))

    (setq vZ1 (caddr vec1) vZ2 (caddr vec2))
    (if (not vZ1) (setq vZ1 0.0))
    (if (not vZ2) (setq vZ2 0.0))

    ;; normalised vectors must be the same
    (setq len1 (sqrt (+ (* vX1 vX1) (* vY1 vY1) (* vZ1 vZ1))))
    (setq len2 (sqrt (+ (* vX2 vX2) (* vY2 vY2) (* vZ2 vZ2))))
    (if (equal len1 0.0 vle_g_vecTol) (setq len1 1.0))
    (if (equal len2 0.0 vle_g_vecTol) (setq len2 1.0))
    (setq len1 (/ 1.0 len1))
    (setq len2 (/ 1.0 len2))

    (equal (list (* vX1 len1) (* vY1 len1) (* vZ1 len1))
           (list (* vX2 len2) (* vY2 len2) (* vZ2 len2))
           vle_g_vecTol
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-getperpvector                                          |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-getperpvector vec)                                               |
;;|                                                                              |
;;| returns a vector which is perpendicular to 'vec'                             |
;;|                                                                              |
;;| Arguments : 'vec'  a 2d or 3d vector list                                    |
;;|                                                                              |
;;| Return    : (vecX vecY vecZ) 3D vector (normalised) orthogonal to 'vec'      |
;;|                                                                              |
;;| Note : returned perpendicular vector is always normalised (unit-length)      |
;;================================================================================
(if (not vle-vector-getperpvector)
  (defun vle-vector-getperpvector ( vec / vX vY vZ len res )
    (if (/= (type vec) 'LIST) (exit))

    (setq vX (car vec) vY (cadr vec))
    (if (or (not vX) (not vY)) (exit))

    (setq vZ (caddr vec))
    (if (not vZ) (setq vZ 0.0))

    (if (and (< (abs vX) vle_g_vecTol) (< (abs vY) vle_g_vecTol))
      (if (< (abs vZ) vle_g_vecTol)
        (setq res (list (* -1.0 vY) vX 0.0))
        (setq res (list vZ 0.0 0.0))
      )
      (setq res (list (* -1.0 vY) vX 0.0))
    )

    (setq vX (car res) vY (cadr res) vZ (caddr res))

    (setq len (sqrt (+ (* vX vX) (* vY vY) (* vZ vZ))))
    (if (equal len 0.0 vle_g_vecTol) (setq len 1.0))
    (setq len (/ 1.0 len))

    (list (* vX len) (* vY len) (* vZ len))
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-getucs                                                 |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-getucs normal)                                                   |
;;|                                                                              |
;;| returns the list of u-axis and v-axis for the given 'normal' vector          |
;;|                                                                              |
;;| Arguments : 'normal' a 2d or 3d vector list representing the Z normal vector |
;;|                                                                              |
;;| Return    : *((uX uY uZ) (vX vY vZ))  list of u-axis and v-axis vectors      |
;;|                                                                              |
;;| Note : returned axis vectors are always normalised;                          |
;;|        input 'normal' must not be unit-length (non-normalised is allowed)    |
;;================================================================================
(if (not vle-vector-getucs)
  (defun vle-vector-getucs ( normal / zvec xvec yvec )
    (setq zvec (vle-vector-normalise normal))
    (setq xvec (vle-vector-getperpvector zvec))
    (setq yvec (vle-vector-crossproduct zvec xvec))
    (list xvec yvec)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-angleto                                                |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-angleto vec1 vec2)                                               |
;;|                                                                              |
;;| returns the angle between vectors 'vec1' and 'vec2'                          |
;;|                                                                              |
;;| Arguments : 'vec1'  a 2d or 3d vector list                                   |
;;|             'vec2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : double, the angle (in radians) in range 0 ... PI                 |
;;|                                                                              |
;;| Note : input vectors must not be unit-length (non-normalised is allowed)     |
;;================================================================================
(if (not vle-vector-angleto)
  (defun vle-vector-angleto ( vec1 vec2 / crossProd dotProd len )
    (setq crossProd (vle-vector-crossproduct vec1 vec2))
    (setq dotProd (vle-vector-dotproduct vec1 vec2))
    (setq len (vle-vector-length crossProd))
    (atan len dotProd)
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-angletoref                                             |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-angletoref vec1 vec2 normal)                                     |
;;|                                                                              |
;;| returns the angle between vectors 'vec1' and 'vec2', using 'normal' as       |
;;|         as reference vector, which defines the vector plane                  |
;;|                                                                              |
;;| Arguments : 'vec1'    a 2d or 3d vector list                                 |
;;|             'vec2'    a 2d or 3d vector list                                 |
;;|             'normal'  a 2d or 3d vector list, specifies the plane normal     |
;;|                                                                              |
;;| Return    : double, the angle (in radians) in range 0 ... 2PI                |
;;|                                                                              |
;;| Note : input vectors must not be unit-length (non-normalised is allowed)     |
;;================================================================================
(if (not vle-vector-angletoref)
  (defun vle-vector-angletoref ( vec1 vec2 normal / crossProd dotProd len ang ref )
    (setq crossProd (vle-vector-crossproduct vec1 vec2))
    (setq dotProd (vle-vector-dotproduct vec1 vec2))
    (setq len (vle-vector-length crossProd))
    (setq ang (atan len dotProd))

    (setq ref (vle-vector-dotproduct normal crossProd))
    (if (>= ref 0.0)
      ang
      (- (* 2 PI) ang)
    )
  )
)

;;================================================================================
;;| FUNCTION : vle-vector-midpoint                                               |
;;|------------------------------------------------------------------------------|
;;| (vle-vector-midpoint pnt1 pnt2)                                              |
;;|                                                                              |
;;| returns the mid point of the 2 input points 'pnt1' and 'pnt2'                |
;;|                                                                              |
;;| Arguments : 'pnt1'  a 2d or 3d vector list                                   |
;;|             'pnt2'  a 2d or 3d vector list                                   |
;;|                                                                              |
;;| Return    : point (list of 3 doubles)                                        |
;;|                                                                              |
;;| Note :                                                                       |
;;================================================================================
(if (not vle-vector-midpoint)
  (defun vle-vector-midpoint ( pnt1 pnt2 / pz1 pz2 )
    (if (or (not (car pnt1)) (not (cadr pnt1))) (exit))
    (if (or (not (car pnt2)) (not (cadr pnt2))) (exit))
    (setq pz1 (if (caddr pnt1) (caddr pnt1) 0.0))
    (setq pz2 (if (caddr pnt2) (caddr pnt2) 0.0))
    (list (* (+ (car pnt1) (car pnt2)) 0.5) (* (+ (cadr pnt1) (cadr pnt2)) 0.5) (* (+ pz1 pz2) 0.5))
  )
)



(princ)
