alanjt's Misc. Useful Lisp Subroutines

Thought I would start one of these. Modify them however you like. I prefix mine with AT: just to keep things organized, and it makes things easier to search through the atoms-family for loaded.

They are either stuff I use, stuff I've written just to write it, or posted posted somewhere and felt it was worth hanging on to.

If you like it, take it, if not, sorry.

;;; Remove Z value from point
;;; Alan J. Thompson, 3.18.09
(defun AT:FlatPoint (#Point)
(list (car #Point) (cadr #Point))
)



;;; Distance between 2 (no Z value) points
;;; Alan J. Thompson, 3.18.09
(defun AT:FlatDist (#Point1 #Point2)
(distance (list (car #Point1) (cadr #Point1))
          (list (car #Point2) (cadr #Point2))
)
)

;;; Convert point to a Vla Array
;;; #PointOrMessage - Point to convert, message for getpoint or nil for getpoint with generic message
;;; Alan J. Thompson, 05.23.09
(defun AT:VlaPoint (#PointOrMessage / #PointOrMessage)
 (or #PointOrMessage
     (setq #PointOrMessage "\nSpecify point: ")
 ) ;_ or
 (cond
   ((vl-consp #PointOrMessage)
    (setq #PointOrMessage (vlax-3D-point #PointOrMessage))
   )
   ((eq (type #PointOrMessage) 'STR)
    (if (setq #PointOrMessage (getpoint #PointOrMessage))
      (setq #PointOrMessage (vlax-3D-point #PointOrMessage))
    ) ;_ if
   )
 ) ;_ cond
) ;_ defun

;;; Convert an Array or Variant to Standard List
;;; #ArrayVariant - Array or Variant to convert
;;; Alan J. Thompson, 08.14.09
(defun AT:ArrayVariant->List (#ArrayVariant)
 (cond
   ((eq (type #ArrayVariant) 'variant)
    (vlax-safearray->list (vlax-variant-value #ArrayVariant))
   )
   ((eq (type #ArrayVariant) 'safearray)
    (vlax-safearray->list #ArrayVariant)
   )
 ) ;_ cond
) ;_ defun

;;; Get angle of line ENAME
;;; #Line - Line ENAME to get angle from
;;; Alan J. Thompson, 09.08.09
(defun AT:LineAngle (#Line)
 (angle (cdr (assoc 10 (entget #Line)))
        (cdr (assoc 11 (entget #Line)))
 ) ;_ angle
) ;_ defun




;;; Convert Point List (X&Y) into Array
;;; #List - List of points to convert
;;; Alan J. Thompson, 09.16.09
(defun AT:PointXYList->Array (#List)
 (vlax-Make-Variant
   (vlax-SafeArray-Fill
     (vlax-Make-SafeArray
       vlax-vbDouble
       (cons 0 (- (length #List) 1))
     ) ;_ vlax-Make-SafeArray
     #List
   ) ;_ vlax-SafeArray-Fill
 ) ;_ vlax-Make-Variant
) ;_ defun

;;; Extract all Attributes from Block or Multileader w/Block
;;; #Object - Block/Multileader to extract attributes
;;; Alan J. Thompson, 08.17.09
(defun AT:GetAttributes (#Object / #Object #Entget)
 (if #Object
   (progn
     ;; if list, strip out ename
     (and (vl-consp #Object) (setq #Object (car #Object)))
     (cond
       ;; if vla-object & multileader with block, convert to ename
       ((and (eq (type #Object) 'VLA-OBJECT)
             (vlax-property-available-p #Object 'ContentBlockName)
        ) ;_ and
        (setq #Object (vlax-vla-object->ename #Object))
       )
       ;; if ename & block, convert to vla-object
       ((and (eq (type #Object) 'ENAME)
             (eq "INSERT" (cdr (assoc 0 (entget #Object))))
        ) ;_ and
        (setq #Object (vlax-ename->vla-object #Object))
       )
     ) ;_ cond
     ;; run through options
     (cond
       ;; vla-object & attributed block
       ((and (eq (type #Object) 'VLA-OBJECT)
             (eq "AcDbBlockReference"
                 (vla-get-objectname #Object)
             ) ;_ eq
             (eq (vla-get-hasattributes #Object) :vlax-true)
        ) ;_ and
        (vlax-safearray->list
          (vlax-variant-value
            (vla-getattributes #Object)
          ) ;_ vlax-variant-value
        ) ;_ vlax-safearray->list
       )
       ;; ename or entsel-style list
       ((or (eq (type #Object) 'ENAME)
            (vl-consp #Object)
        ) ;_ or
        (setq #Entget (entget #Object))
        (vl-remove-if
          '(lambda (x)
             (or (not x)
                 (not (eq "AcDbAttributeDefinition"
                          (vla-get-objectname x)
                      ) ;_ eq
                 ) ;_ not
             ) ;_ or
           ) ;_ lambda
          (mapcar
            '(lambda (x)
               (if (eq 330 (car x))
                 (vlax-ename->vla-object (cdr x))
               ) ;_ if
             ) ;_ lambda
            #Entget
          ) ;_ mapcar
        ) ;_ vl-remove-if
       )
     ) ;_ cond
   ) ;_ progn
 ) ;_ if
) ;_ defun

;;; ------------------------------------------------------------------------
;;;    AT:SetObjectLayer.lsp v1.0
;;;    (SubRoutine)
;;;
;;;    Copyright© 04.08.09
;;;    Alan J. Thompson (alanjt)
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    The following program(s) are provided "as is" and with all faults.
;;;    Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;;    will be uninterrupted and/or error free.
;;;
;;;    Civil 3D ONLY!
;;;    Set layer of specified Object Layer Setting
;;;    User is responsible for existince of Object Setting & Layer
;;;
;;;    Only tested in Civil 3D 2009
;;;
;;;    Arguments: #ObjType - Object type layer to alter
;;;           #Layer - Layer to set for above object type
;;;
;;;    Examples: (AT:SetObjectLayer 'GeneralNoteLabelLayer (getvar "clayer"))
;;;          (AT:SetObjectLayer 'GeneralSegmentLabelLayer (getvar "clayer"))
;;;
;;;    Revision History:
;;;
;;; ------------------------------------------------------------------------


(defun AT:SetObjectLayer
      (#ObjType #Layer / #Version #AppNum #ObjLaySet #Result)
;;; 'GeneralNoteLabelLayer
;;; 'GeneralSegmentLabelLayer
 (vl-load-com)
 (cond ((setq #Version (vlax-product-key)
              #AppNum  (cond ;;2006
                             ((vl-string-search "R16.2" #Version) "3.0")
                             ;;2007
                             ((vl-string-search "R17.0" #Version) "4.0")
                             ;;2008
                             ((vl-string-search "R17.1" #Version) "5.0")
                             ;;2009
                             ((vl-string-search "R17.2" #Version) "6.0")
                             ;;No Match
                             (t nil)
                       ) ;_ cond
        ) ;_ setq
        (setq #ObjLaySet
               (vlax-get
                 (vlax-get
                   (vlax-get
                     (vlax-get
                       (vla-GetInterfaceObject
                         (vlax-get-acad-object)
                         (strcat
                           "AeccXUiLand.AeccApplication."
                           #AppNum
                         ) ;_ strcat
                       ) ;_ vla-GetInterfaceObject
                       'ActiveDocument
                     ) ;_ vlax-get
                     'Settings
                   ) ;_ vlax-get
                   'DrawingSettings
                 ) ;_ vlax-get
                 'ObjectLayerSettings
               ) ;_ vlax-get
        ) ;_ setq
        (vlax-put
          (vlax-get #ObjLaySet #ObjType)
          'Layer
          #Layer
        ) ;_ vlax-put
        (setq #Result (eq #Layer
                          (vlax-get
                            (vlax-get #ObjLaySet #ObjType)
                            'Layer
                          ) ;_ vlax-get
                      ) ;_ eq
        ) ;_ setq
        (vlax-release-object #ObjLaySet)
       )
 ) ;_ cond
 #Result
) ;_ defun

;;; Extract number, northing, easting, elevation & description
;;; from Civil 3D point object. Only tested in Civil 3D 2009.
;;; #PointObj - Civil 3D point VLA-OBJECT
;;; Alan J. Thompson, 06.09.09
(defun AT:C3DPointInfo (#PointObj / #List)
 (and (eq (type #PointObj) 'VLA-OBJECT)
      (eq (vla-get-objectname #PointObj) "AeccDbCogoPoint")
      (setq #List (mapcar '(lambda (x)
                             (vl-catch-all-apply 'vlax-get-property (list #PointObj x))
                           ) ;_ lambda
                          (list 'Number 'Northing 'Easting 'Elevation 'Description)
                  ) ;_ mapcar
      ) ;_ setq
      (vlax-release-object #PointObj)
      (setq #List (vl-remove-if 'null #List))
      (setq #List (list (car #List)
                        (list (caddr #List) (cadr #List) (cadddr #List))
                        (last #List)
                  ) ;_ list
      ) ;_ setq
 ) ;_ and
 #List
) ;_ defun

;;; Insert all Page Setups into drawing (will overwrite if exists)
;;; #DrawingFile - name of DWG file from which to import
;;; Alan J. Thompson, 07.29.09
(defun AT:PageSetups (#DrawingFile)
 (if (findfile #DrawingFile)
   (progn
     (command "_.psetupin" (findfile #DrawingFile) "*")
     (while (wcmatch (getvar "cmdnames") "*PSETUPIN*")
       (command "_yes")
     ) ;_ while
     T
   ) ;_ progn
 ) ;_ if
) ;_ defun

;;; Get/Set Variables
;;; Credit to: *ElpanovEvgeniy*
;;; (used his error function as an example)
;;; #List - list of variables (cmdecho, dimzin)
;;; #Get - if T, will create list of variables & values,
;;;        nil will set the previously created eval list
;;; Alan J. Thompson, 04.21.09
(defun AT:Vars (#List #Get)
 (if #Get
   (mapcar
     '(lambda (x)
        (list 'setvar x (getvar x))
      ) ;_ lambda
     #List
   ) ;_ mapcar
   (mapcar 'eval #List)
 ) ;_ if
) ;_ defun




;;; Setvar Replacement
;;; #Variable - Variable to set
;;; #Setting - Setting for setvar
;;; Example - (AT:Setvar "clayer" "A") -> "A"
;;; Example - (AT:Setvar "cclayerr" "A" -> nil
;;; Alan J. Thompson, 05.05.09
(defun AT:Setvar (#Variable #Setting / #Check)
 (if (not (vl-catch-all-error-p
            (setq #Check
                   (vl-catch-all-apply 'setvar (list #Variable #Setting))
            ) ;_ setq
          ) ;_ vl-catch-all-error-p
     ) ;_ not
   #Check
 ) ;_ if
) ;_ defun

;;; Check if two points are same
;;; Return: T if same, nil if different
;;; Alan J. Thompson, 04.28.09
(defun AT:PointSame (#Point1 #Point2)
 (equal #Point1 #Point2 0.00001)
) ;_ defun




;;;Check if two points are same X & Y (Z ignored)
;;;Return: T if same, nil if different
;;;Alan J. Thompson, 05.04.09
(defun AT:PointSameXY (#Point1 #Point2)
 (equal (list (car #Point1) (cadr #Point1))
        (list (car #Point2) (cadr #Point2))
        0.00001
 ) ;_ equal
) ;_ defun

;;; Write list to file
;;; #File - file to write list to (must be in form "c:\\File.txt")
;;; #ListToWrite - list to write to file
;;; #Overwrite - If T, will overwrite; nil to append
;;; Alan J. Thompson, 04.28.09
(defun AT:WriteToFile (#File #ListToWrite #Overwrite / #FileOpen)
 (cond ((and (vl-consp #ListToWrite)
             (setq #FileOpen (open #File
                                   (if #Overwrite
                                     "W"
                                     "A"
                                   ) ;_ if
                             ) ;_ open
             ) ;_ setq
        ) ;_ and
        (foreach x #ListToWrite
          (write-line x #FileOpen)
        ) ;_ foreach
        (close #FileOpen)
        T
       )
 ) ;_ cond
) ;_ defun




;;; Copy entire contents of folder to new folder (No Subfolders)
;;; #Source - source directory of files to copy (subfolders excluded)
;;; #Destination - destination for copied files (created if doesn't exist)
;;; Alan J. Thompson, 05.12.09
(defun AT:CopyDirectoryFiles (#Source #Destination)
 (and (findfile #Source)
      (or (findfile #Destination) (vl-mkdir #Destination))
      (mapcar '(lambda (x)
                 (vl-file-copy (strcat #Source "\\" x)
                               (strcat #Destination "\\" x)
                 ) ;_ vl-file-copy
               ) ;_ lambda
              (cddr (vl-directory-files #Source))
      ) ;_ mapcar
 ) ;_ and
) ;_ defun




;;; Copy entire contents of directory to new location (subfolders included)
;;; #Source - source folder to copy
;;; #Destination - destination directory (will be created if doesn't exist)
;;; Alan J. Thompson, 09.12.09
(defun AT:CopyDirectory (#Source #Destination)
 (and (findfile #Source)
      (startapp
        (strcat "xcopy " #Source " /E /H /Q /Y /I " #Destination)
      ) ;_ startapp
 ) ;_ and
) ;_ defun

;;; Parse Directory to List
;;; dir - Directory for parsing, such as (getvar "dwgprefix")
;;; Alan J. Thompson, 09.16.09
(defun AT:Directory->List (dir / dir l tdir i)
 (while (vl-string-search "/" dir)
   (setq dir (vl-string-subst "\\" "/" dir))
 ) ;_ while
 (or (eq "\\" (substr dir (strlen dir)))
     (setq dir (strcat dir "\\"))
 ) ;_ or
 (setq l (cons (substr dir 1 (vl-string-search "\\" dir 0)) l))
 (setq tdir (substr dir (+ 2 (vl-string-search "\\" dir 0))))
 (while (not (eq "" tdir))
   (setq
     l (cons (substr tdir 1 (setq i (vl-string-search "\\" tdir 0)))
             l
       ) ;_ cons
   ) ;_ setq
   (setq tdir (substr tdir (+ 2 i)))
 ) ;_ while
 (reverse l)
) ;_ defun

;list select dialog
;create a temp DCL multi-select list dialog from provided list
;value is returned in list form, DCL file is deleted when finished
;example: (setq the_list (AT:listselect "This is my list title" "Select items to make a list" "25" "30" "true" (list "object 1" "object 2" "object 3"))
;if mytitle is longer than defined width, the width will be ignored and it will fit to title string
;if mylabel is longer than defined width, mylabel will be truncated
;myheight and mywidth must be strings, not numbers
;mymultiselect must either be "true" or "false" (true for multi, false for single)
;created by: alan thompson, 9.23.08
;some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples)

(defun AT:ListSelect  ( mytitle       ;title for dialog box
           mylabel       ;label right above list box
           myheight      ;height of dialog box !!*MUST BE STRING*!!
           mywidth       ;width of dialog box !!*MUST BE STRING*!!
           mymultiselect ;"true" for multiselect, "false" for single select
           mylist        ;list to display in list box
           / retlist readlist count item savevars fn fo valuestr dcl_id )
(defun saveVars(/ readlist count item)
 (setq retList(list))
 (setq readlist(get_tile "mylist"))
 (setq count 1)
 (while (setq item (read readlist))
   (setq retlist(append retList (list (nth item myList))))
   (while
     (and
       (/= " " (substr readlist count 1))
       (/= ""   (substr readlist count 1))
     )
     (setq count (1+ count))
   )
   (setq readlist (substr readlist count))
 )
);defun
(setq fn (vl-filename-mktemp "" "" ".dcl"))
(setq fo (open fn "w"))
(setq valuestr (strcat "value = \"" mytitle "\";"))
(write-line (strcat "list_select : dialog {
           label = \"" mytitle "\";") fo)
(write-line 
(strcat "          : column {
           : row {
             : boxed_column {
              : list_box {
                 label =\"" mylabel "\";
                 key = \"mylist\";
                 allow_accept = true;
                 height = " myheight ";
                 width = " mywidth ";
                 multiple_select = " mymultiselect ";
                 fixed_width_font = false;
                 value = \"0\";
               }
             }
           }
           : row {
             : boxed_row {
               : button {
                 key = \"accept\";
                 label = \" Okay \";
                 is_default = true;
               }
               : button {
                 key = \"cancel\";
                 label = \" Cancel \";
                 is_default = false;
                 is_cancel = true;
               }
             }
           }
         }
}") fo)
(close fo)
(setq dcl_id (load_dialog fn))
(new_dialog "list_select" dcl_id)
 (start_list "mylist" 3)
 (mapcar 'add_list myList)
 (end_list)
 (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
 (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)")
 (start_dialog)
 (if (= ddiag 1)
    (setq retlist nil)
 )
(unload_dialog dcl_id)
(vl-file-delete fn)
retlist
);defun

;;; Getstring Dialog Box
;;; #Title - Title of dialog box
;;; #Default - Default string within edit box
;;; Alan J. Thompson, 08.25.09
(defun AT:GetString
      (#Title #Default / #FileName #FileOpen #DclID #NewString)
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 ) ;_ setq
 (foreach x '("TempEditBox : dialog {" "key = \"Title\";"
              "label = \"\";" "initial_focus = \"Edit\";" "spacer;"
              ": row {" ": column {" "alignment = centered;"
              "fixed_width = true;" ": text {" "label = \"\";" "}" "}"
              ": edit_box {" "key = \"Edit\";" "allow_accept = true;"
              "edit_width = 40;" "fixed_width = true;" "}" "}"
              "spacer;" ": row {" "fixed_width = true;"
              "alignment = centered;" ": ok_button {" "width = 11;" "}"
              ": cancel_button {" "width = 11;" "}" "}" "}//"
             )
   (write-line x #FileOpen)
 ) ;_ foreach
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile
   "accept"
   "(setq #NewString (get_tile \"Edit\"))(done_dialog)"
 ) ;_ action_tile
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
) ;_ defun

;;; Edit text box (Old Mtext editor)
;;; Returns typed in textstring
;;; Alan J. Thompson, 09.18.09
(defun AT:EditTextBox (/ *error* #Cmdecho #Mtexted #Mtext #String)
 (setq *error*  (lambda (msg)
                  (and #Mtext (entdel #Mtext))
                  (and #Cmdecho (setvar "cmdecho" #Cmdecho))
                  (and #Mtexted (setvar "mtexted" #Mtexted))
                ) ;_ lambda
       #Cmdecho (getvar "cmdecho")
       #Mtexted (getvar "mtexted")
 ) ;_ setq
 (setvar "cmdecho" 0)
 (vl-catch-all-apply 'setvar (list "mtexted" "OldEditor"))
 (setq #Mtext (entmakex (list
                          '(0 . "MTEXT")
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbMText")
                          (cons 10 (trans (cadr (grread t 4 4)) 1 0))
                        ) ;_ list
              ) ;_ entmakex
 ) ;_ setq
 (vl-cmdf "_.mtedit" #Mtext)
 (setq #String (vla-get-textstring (vlax-ename->vla-object #Mtext)))
 (*error* nil)
 (if (/= #String "")
   #String
 ) ;_ if
) ;_ defun

;;; Return List of Layers
;;; created: Alan J. Thompson 3.2.09
(defun AT:LayerList (/ search names)
 (while
   (setq search (tblnext "layer" (null search)))
   (setq names (cons (cdr (assoc 2 search)) names))
 );while
   (setq names (acad_strlsort names))
);defun



;;; Layer On Routine
;;; created: Alan J. Thompson 3.2.09
(defun AT:LayerOn (layer / ent color )
(if (setq ent (entget (tblobjname "layer" layer)))
   (progn
    (setq color (assoc 62 ent))
    (entmod (subst (cons 62 (abs (cdr color))) color ent))
   );progn
);if
(princ)
);defun



 ;; Layer Freeze Routine
 ;; created: Alan J. Thompson 3.2.09
 (defun AT:LayerFreeze (layer / ent frz? lay0 frz?0)
   (if (setq ent (entget (tblobjname "LAYER" layer)))
     (progn
       (setq frz? (assoc 70 ent))
       (if (= (cdr (assoc 2 ent))
              (getvar "clayer")
           ) ;_ =
         (progn
           (setq lay0 (entget (tblobjname "LAYER" "0")))
           (setq frz?0 (assoc 70 lay0))
           (entmod (subst (cons 70 0) frz?0 lay0))
           (setvar "clayer" "0")
         ) ;progn
       ) ;if
       (entmod (subst (cons 70 1) frz? ent))
     ) ;progn
   ) ;if
   (princ)
 ) ;_ defun


;;; Layer Off Routine
;;; created: Alan J. Thompson 3.2.09
(defun AT:LayerOff (layer / ent color )
(if (setq ent (entget (tblobjname "layer" layer)))
   (progn
    (setq color (assoc 62 ent))
    (entmod (subst (cons 62 (- (abs (cdr color)))) color ent))
   );progn
);if
(princ)
);defun


;;; Layer Set Routine
;;; created: Alan J. Thompson 3.2.09
(defun AT:LayerSet ( layer / ent frz? color )
(if (setq ent (entget (tblobjname "LAYER" layer)))
  (progn
   (setq frz? (assoc 70 ent))
   (entmod (subst (cons 70 0) frz? ent))
   (setq ent (entget (tblobjname "LAYER" layer)))
   (setq color (assoc 62 ent))
   (entmod (subst (cons 62 (abs (cdr color))) color ent))
   (setvar "clayer" layer)
  );progn
);if
(princ)
);defun


;;; Create list of layer objects in drawing (excluding frozen)
;;; Alan J. Thompson, 04.16.09
 (defun AT:LayerListNoFreeze (/ #Layers #List)
   (setq #Layers (vla-get-Layers
                   (vla-get-activedocument
                     (vlax-get-acad-object)
                   ) ;_ vla-get-activedocument
                 ) ;_ vla-get-Layers
   ) ;_ setq
   (vlax-for x #Layers
     (if (eq (vla-get-Freeze x) :vlax-false)
       (setq #List (cons x #List))
     ) ;_ if
   ) ;_ vlax-for
   (vlax-release-object #Layers)
   #List
 ) ;_ defun


;;; Invert On/Off state of Vla layer object
;;; Alan J. Thompson, 04.16.09
 (defun AT:LayerInvertOnOff (#LayerObj)
   (if (eq (vla-get-LayerOn #LayerObj)
           :vlax-true
       ) ;_ eq
     (vla-put-LayerOn #LayerObj :vlax-false)
     (vla-put-LayerOn #LayerObj :vlax-true)
   ) ;_ if
 ) ;_ defun


;;; Create list of layer objects in drawing (turned off)
;;; Alan J. Thompson, 04.28.09
 (defun AT:LayerListOff (/ #Layers #List)
   (setq #Layers (vla-get-Layers
                   (vla-get-activedocument
                     (vlax-get-acad-object)
                   ) ;_ vla-get-activedocument
                 ) ;_ vla-get-Layers
   ) ;_ setq
   (vlax-for x #Layers
     (if (eq (vla-get-LayerOn x) :vlax-false)
       (setq #List (cons x #List))
     ) ;_ if
   ) ;_ vlax-for
   (vlax-release-object #Layers)
   #List
 ) ;_ defun


;;; Create a list of layers in drawing (excluding Xrefs)
;;; #Names - If T will give list of names, nil list of
;;;          vla layer objects
;;; Alan J. Thompson, 05.05.09
(defun AT:LayerListNoXref (#Names / #Layers #List)
 (setq #Layers (vla-get-Layers
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 ) ;_ vla-get-activedocument
               ) ;_ vla-get-Layers
 ) ;_ setq
 (vlax-for x #Layers
   (if (not (wcmatch (vla-get-name x) "*|*"))
     (setq #List (cons (if #Names
                         (vla-get-name x)
                         x
                       ) ;_ if
                       #List
                 ) ;_ cons
     ) ;_ setq
   ) ;_ if
 ) ;_ vlax-for
 (vlax-release-object #Layers)
 (if #Names
   (vl-sort #List '<)
   #List
 ) ;_ if
) ;_ defun



;;; Convert existing layer to VLA-Object
;;; #Layer - name of layer
;;; Alan J. Thompson, 05.07.09
(defun AT:LayerObj (#Layer / #Obj)
 (and (tblsearch "layer" #Layer)
      (setq #Obj (vla-item (vla-get-Layers
                             (vla-get-activedocument
                               (vlax-get-acad-object)
                             ) ;_ vla-get-activedocument
                           ) ;_ vla-get-Layers
                           #Layer
                 ) ;_ vla-item
      ) ;_ setq
 ) ;_ and
 #Obj
) ;_ defun



;;; Create list of frozen layer objects in drawing
;;; Alan J. Thompson, 06.08.09
 (defun AT:LayerListFrozen (/ #Layers #List)
   (setq #Layers (vla-get-Layers
                   (vla-get-activedocument
                     (vlax-get-acad-object)
                   ) ;_ vla-get-activedocument
                 ) ;_ vla-get-Layers
   ) ;_ setq
   (vlax-for x #Layers
     (if (eq (vla-get-Freeze x) :vlax-true)
       (setq #List (cons x #List))
     ) ;_ if
   ) ;_ vlax-for
   (vlax-release-object #Layers)
   #List
 ) ;_ defun



;;; Thaw specified layer object
;;; #LayerObj - vla layer object
;;; Alan J. Thompson, 06.08.09
(defun AT:LayerObjThaw (#LayerObj)
 (and (eq (type #LayerObj) 'VLA-OBJECT)
      (vl-catch-all-apply
        '(lambda () (vla-put-freeze #LayerObj :vlax-false) T)
      ) ;_ vl-catch-all-apply
 ) ;_ and
) ;_ defun



;;; List of layer objects
;;; Alan J. Thompson, 06.02.09
(defun AT:LayerObjList (/ #List)
 (vlax-for x (vla-get-Layers
               (vla-get-activedocument
                 (vlax-get-acad-object)
               ) ;_ vla-get-activedocument
             ) ;_ vla-get-Layers
   (setq #List (cons x #List))
 ) ;_ vlax-for
 #List
) ;_ defun



;;; Turn off specified layer object
;;; #LayerObj - vla layer object to turn off
;;; Alan J. Thompson, 06.08.09
(defun AT:LayerObjOff (#LayerObj)
 (and (eq (type #LayerObj) 'VLA-OBJECT)
      (vl-catch-all-apply
        '(lambda () (vla-put-layeron #LayerObj :vlax-false) T)
      ) ;_ vl-catch-all-apply
 ) ;_ and
) ;_ defun



;;; Turn on specified layer object
;;; #LayerObj - vla layer object to turn on
;;; Alan J. Thompson, 06.08.09
(defun AT:LayerObjOn (#LayerObj)
 (and (eq (type #LayerObj) 'VLA-OBJECT)
      (vl-catch-all-apply
        '(lambda () (vla-put-layeron #LayerObj :vlax-true) T)
      ) ;_ vl-catch-all-apply
 ) ;_ and
) ;_ defun




;;; Delete all objects on and purge specified layer
;;; #LayerName - Layername to delete and purge
;;; Alan J. Thompson, 09.19.09
(defun AT:LayerNuke (#LayerName / #Layers #Layer #SS)
 (setq #Layers (vla-get-layers
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 ) ;_ vla-get-activedocument
               ) ;_ vla-get-layers
 ) ;_ setq
 (if (tblsearch "layer" #LayerName)
   (progn
     (setq #Layer (vla-item #Layers #LayerName))
     (or (not (eq (getvar "clayer") #LayerName))
         (progn
           (vla-put-freeze (vla-item #Layers "0") :vlax-false)
           (setvar "clayer" "0")
         ) ;_ progn
     ) ;_ or
     (vla-put-freeze #Layer :vlax-false)
     (vla-put-lock #Layer :vlax-false)
     (and (setq #SS (ssget "_X" (list (cons 8 #LayerName))))
          (mapcar
            '(lambda (x) (vla-delete (vlax-ename->vla-object (cadr x))))
            (ssnamex #SS)
          ) ;_ mapcar
     ) ;_ and
     (not (vla-delete #Layer))
   ) ;_ progn
 ) ;_ if
) ;_ defun

Similar to vl-position, but it will return ALL, not just first.

;;; Search list for matching value, returns list of nth count locations
;;; #Value - value to search list for
;;; #List - list to search
;;; Alan J. Thompson, 06.16.09
(defun AT:ListSearch (#Value #List / #Count)
 (setq #Count -1)
 (vl-remove-if
   'null
   (mapcar '(lambda (x)
              (setq #Count (1+ #Count))
              (if (eq #Value x)
                #Count
              ) ;_ if
            ) ;_ lambda
           #List
   ) ;_ mapcar
 ) ;_ vl-remove-if
) ;_ defun

;;; Remove nth item from list
;;; #Nth - nth number in list to remove
;;; #List - list to process
;;; Alan J. Thompson, 06.16.09
(defun AT:NthRemove (#Nth #List / #Index)
 (setq #Index -1)
 (vl-remove-if
   '(lambda (x) (eq #Nth (setq #Index (1+ #Index))))
   #List
 ) ;_ vl-remove-if
) ;_ defun

;;; Replace nth item in list
;;; #Nth - nth number in list to replace
;;; #New - replacement item
;;; #List - list to process
;;; Alan J. Thompson, 06.16.09
(defun AT:NthReplace (#Nth #New #List / #Count)
 (setq #Count -1)
 (mapcar '(lambda (x)
            (if (eq #Nth (setq #Count (1+ #Count)))
              #New
              x
            ) ;_ if
          ) ;_ lambda
         #List
 ) ;_ mapcar
) ;_ defun

;;; Convert all values in list and sublists to positive numbers
;;; #List - list with values to convert
;;; Alan J. Thompson, 06.14.09
(defun AT:AbsList (#List)
 (mapcar
   '(lambda (x)
      (cond
        ((vl-consp x) (AT:AbsList x))
        ((member (type x) (list 'INT 'REAL)) (abs x))
        (T x)
      ) ;_ cond
    ) ;_ lambda
   #List
 ) ;_ mapcar
) ;_ defun