I was gonna post this to the Lillypond but that dang thing confuddles me everytime.. This is an earlier one from Cadalyst. 2002 I believe.. So, here goes:
;Tip1775: LIB.LSP MANAGE ROUTINES (c)2002, Roy Everitt
;;; Lib.lsp
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Copyright© Roy Everitt
;;; March, 2000
;;;
;;; Note: Older versions of Autocad will not recognize the *error* function. You will
;;; need to replace the (defun-q *error* (msg) statement with (defun *error* (msg).
;;;
;;; This program allows you to add all of your favorite lisp routines to an easily modified
;;; list, then execute them from a list box selection.
;;;
;;; Step 1. Define your preferences for functions that execute your programs.
;;; Example: (DEFUN C:Table ()(Load "Table") (c:Table))...see below "dlg_main" function.
;;; Step 2. Add a Quoted description to the list in "set_pgm_name" function for your program.
;;; Example: "Add a Chart or (Table) to your drawing (c:Table)"
;;; Note: This list will automatically be sorted by the acad_strlsort function as coded.
;;; Use the sample programs table.lsp, altext.lsp, half.lsp & ct.lsp to test lib.lsp
;;; for compatibility with your settings. Be sure to change the *error* function from
;;; (defun-q *error* (msg) to (defun-q *error* (msg), in the table.lsp program, with older
;;; versions of Autocad.
;;; Step 3. Add each equivalant description to the (if ()) statement test for each "lsp_name" list
;;; element, from the "set_pgm_name" function, into the "runit" function, in order for this
;;; program to execute the selected program from the list.
;;; Example:(if (= lsp_name "Add a Chart or (Table) to your drawing (c:Table)")(c:Table))
;;;
;;; You might also want to automatically load this program from the appload "Startup Suite"
;;; in Autocad 2000 or other programs such as (defun S::STARTUP function in acad.lsp with older
;;; versions of Autocad. This will also allow command line program execution from the functions
;;; established in Step 1. It will also help prevent unnecessarily loading programs, when they
;;; may not be used during the current drawing editing session, thus saving computer memory.
;;;
;;; This program can also be used as a "Front End" loader for other functions that you might
;;; want to have available for access by other programs as well, rather than re-defining those
;;; functions in each individual program using them. Some examples of typical functions that
;;; might be used are listed at the end of this file (dtor),(rtod) & (chk_acadver).
;;;
;;; The program also generates a custom DCL file (temp.dcl) that is re-written each
;;; time it is executed. The code may be changed so that temp.dcl is written to, and
;;; found in any user preferred folder, as long as that folder is in the Support Files
;;; Search Path.
;;; Note: By default, it will be written in your Autocad Working Directory, (wherever
;;; your shortcut or "Start In" Icon is set up to work).
;;; Example: Look for the code: (setq fd (open "temp.dcl" "w"))
;;; Change it to: (setq fd (open "c:\\myfolder\\temp.dcl" "w"))
;;; Look for the code: (close (open "temp.dcl" "w") )
;;; Change it to: (close (open "c:\\myfolder\\temp.dcl" "w") )
;;; Look for the code: (if (< (setq *libid* (load_dialog "temp.dcl")) 0)
;;; Change it to: (if (< (setq *libid* (load_dialog "c:\\myfolder\\temp.dcl")) 0)
;;; (Where "myfolder" is your designated folder name)
;;;=================================================================================
(princ "\Lib Program Loading...")
(defun
C:LIB (/ OL OS OC CR DLG_CLOSE FD DLG_HEADER DLG_MAIN DLG_DIALOG
DLG_CHK DLG_ITEM DLG_ATT SYMTOS DLG_PROTO DCL_TEMP
SET_PGM_NAME PGM_LIST PGM_NUM NUM GET_PGM_LIST LSP_NAME
*LIBID* CATEGORY PICK_CATEGORY NO_OF_LSPS ACADREL
)
;;;;;MAIN DIALOG CONTROL FUNCTIONS;;;;
(defun CR () (princ "\n" FD))
(defun DLG_CLOSE () (princ "}" FD) (CR))
(defun
DLG_HEADER (AUDIT)
(princ "dcl_settings : default_dcl_settings {" FD)
(CR)
(princ (strcat " audit_level = " (itoa AUDIT) "; }") FD)
(CR)
) ;_ end of defun
(defun DLG_DIALOG (NAME) (princ (strcat NAME " : dialog {") FD) (CR))
(defun DLG_ITEM (ITEM) (princ (strcat ": " ITEM "{") FD) (CR))
(defun DLG_PROTO (type) (princ (strcat type ";") FD) (CR))
(defun
DLG_ATT (ATT VAL)
(cond
((= (type VAL) 'INT)
(princ (strcat ATT "=" (itoa VAL) ";") FD)
(CR)
)
((= (type VAL) 'REAL)
(princ (strcat ATT "=" (rtos VAL) ";") FD)
(CR)
)
((= (type VAL) 'STR)
(princ (strcat ATT "=\"" VAL "\";") FD)
(CR)
)
((= (type VAL) 'SYM)
(princ (strcat ATT "=" (SYMTOS VAL) ";") FD)
(CR)
)
) ;_ end of cond
) ;_ end of defun
(defun
SYMTOS (SYM / FD)
(setq FD (open "symtos.txt" "w"))
(princ SYM FD)
(close FD)
(setq
FD (open "symtos.txt" "r")
SYM (strcase (read-line FD) t)
) ;_ end of setq
(close FD)
SYM
) ;_ end of defun
(defun
DCL_TEMP (/ FD)
(setq FD (open "temp.dcl" "w"))
(DLG_HEADER 0)
;;;Define Main Dialog;;;
(DLG_DIALOG "dlg_main")
(DLG_ATT "label" "Lisp Library Program Execution :")
(DLG_ITEM "popup_list")
(DLG_ATT "label" "Lisp Category Group:")
(DLG_ATT "multiple_select" 'FALSE)
(DLG_ATT "key" "cat_lst")
(DLG_ATT "width" 15)
(DLG_CLOSE)
(DLG_ITEM "text")
(DLG_ATT "width" "20")
(DLG_ATT "key" "no_of_lsps")
(DLG_CLOSE)
(DLG_ITEM "list_box")
(DLG_ATT
"label"
"Available Program Descriptions along with their Commands (c:XXXX)"
) ;_ end of dlg_att
(DLG_ATT "height" 10)
(DLG_ATT "width" 60)
(DLG_ATT "key" "pgm_list")
(DLG_ATT "multiple_select" 'FALSE)
(DLG_ATT "fixed_width" 'TRUE)
(DLG_CLOSE)
(DLG_ITEM "button")
(DLG_ATT "key" "run_pgm")
(DLG_ATT "label" "Execute Selected Program")
(DLG_ATT "fixed_width" 'TRUE)
(DLG_ATT "height" 2)
(DLG_ATT "alignment" 'CENTERED)
(DLG_CLOSE)
(DLG_PROTO "cancel_button")
(DLG_CLOSE)
(close FD)
"temp.dcl"
)
;********************Set Category List Function***********************
;;define your Program Category lists here.
(defun
SET_CATEGORY_LIST ()
(setq
CATEGORY_LIST
(list
"ALL" "BATCH PROCESS DRAWINGS" "CALCULATIONS" "CONVERSONS"
"DIMENSIONING" "FUNCTIONS" "ISOMETRIC TOOLS"
"LAYERING UTILITIES" "LEADERS-ARROWS" "MISC" "LINES-POLYLINES"
"AUTOCAD SETTINGS" "TEXT" "DRAWING SHAPES"
) ;_ end of list
) ;_ end of setq
(if (<= (getvar "maxsort") (length CATEGORY_LIST))
(progn
(setq MSORT (getvar "maxsort"))
(setvar "maxsort" (length CATEGORY_LIST))
(setq CATEGORY_LIST (acad_strlsort CATEGORY_LIST))
(setvar "maxsort" MSORT)
) ;_ end of progn
(setq CATEGORY_LIST (acad_strlsort CATEGORY_LIST))
) ;_ end of if
(start_list "cat_lst")
(mapcar 'add_list CATEGORY_LIST)
(end_list)
)
;********************Set Program List Function***********************
;;define your program lists here, along with their commands for execution.
(defun
SET_PGM_NAME (/ CAT_PICK)
;;*****************Examples List from Samples Programs*******************
;;Add your "All" Lists here and also in their Sub-Category...
(if (= CATEGORY "ALL")
(progn
(setq
PGM_LIST
(list
"Add a Chart or (Table) to your drawing (c:Table)"
"Align Text along (2) Points (c:At)"
"Center a Text string between (2) Points (c:Ct)"
"Locate the Midpoint of any (2) selected Points (c:H)"
"Program Description Example 1 (c:XXX1)"
"Program Description Example 2 (c:XXX2)"
"Program Description Example 3 (c:XXX3)"
"Program Description Example 4 (c:XXX4)"
"Program Description Example 5 (c:XXX5)"
"Program Description Example 6 (c:XXX6)"
"Program Description Example 7 (c:XXX7)"
"Program Description Example 8 (c:XXX8)"
"Program Description Example 9 (c:XXX9)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Batch" Lists here...
(if (= CATEGORY "BATCH PROCESS DRAWINGS")
(progn
(setq
PGM_LIST
(list
"Batch Program Example 1 (c:XXX1)"
"Batch Program Example 2 (c:XXX2)"
"Batch Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Calculation" Lists here...
(if (= CATEGORY "CALCULATIONS")
(progn
(setq
PGM_LIST
(list
"Calculation Program Example 1 (c:XXX1)"
"Calculation Program Example 2 (c:XXX2)"
"Calculation Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Conversion" Lists here...
(if (= CATEGORY "CONVERSONS")
(progn
(setq
PGM_LIST
(list
"Conversion Program Example 1 (c:XXX1)"
"Conversion Program Example 2 (c:XXX2)"
"Conversion Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Dimensioning" Lists here...
(if (= CATEGORY "DIMENSIONING")
(progn
(setq
PGM_LIST
(list
"Dimensioning Program Example 1 (c:XXX1)"
"Dimensioning Program Example 2 (c:XXX2)"
"Dimensioning Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Functions" Lists here...
(if (= CATEGORY "FUNCTIONS")
(progn
(setq
PGM_LIST
(list
"Functions Program Example 1 (c:XXX1)"
"Functions Program Example 2 (c:XXX2)"
"Functions Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Isometric" Lists here...
(if (= CATEGORY "ISOMETRIC TOOLS")
(progn
(setq
PGM_LIST
(list
"Isometric Program Example 1 (c:XXX1)"
"Isometric Program Example 2 (c:XXX2)"
"Isometric Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Layering" Lists here...
(if (= CATEGORY "LAYERING UTILITIES")
(progn
(setq
PGM_LIST
(list
"Layering Program Example 1 (c:XXX1)"
"Layering Program Example 2 (c:XXX2)"
"Layering Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Leaders-Arrows" Lists here...
(if (= CATEGORY "LEADERS-ARROWS")
(progn
(setq
PGM_LIST
(list
"Leaders-Arrows Program Example 1 (c:XXX1)"
"Leaders-Arrows Program Example 2 (c:XXX2)"
"Leaders-Arrows Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Miscellaneous" Lists here...
(if (= CATEGORY "MISC")
(progn
(setq
PGM_LIST
(list
"Miscellaneous Program Example 1 (c:XXX1)"
"Miscellaneous Program Example 2 (c:XXX2)"
"Miscellaneous Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Lines-Polylines" Lists here...
(if (= CATEGORY "LINES-POLYLINES")
(progn
(setq
PGM_LIST
(list
"Lines-Polylines Program Example 1 (c:XXX1)"
"Lines-Polylines Program Example 2 (c:XXX2)"
"Lines-Polylines Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Autocad Settings" Lists here...
(if (= CATEGORY "AUTOCAD SETTINGS")
(progn
(setq
PGM_LIST
(list
"Autocad Settings Program Example 1 (c:XXX1)"
"Autocad Settings Program Example 2 (c:XXX2)"
"Autocad Settings Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Text" Lists here...
(if (= CATEGORY "TEXT")
(progn
(setq
PGM_LIST
(list
"Align Text along (2) Points (c:At)"
"Center a Text string between (2) Points (c:Ct)"
"Text Program Example 3 (c:XXX3)"
"Text Program Example 4 (c:XXX4)"
"Text Program Example 5 (c:XXX5)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
:***************************************************
;;;Add your "Drawing Shapes" Lists here...
(if (= CATEGORY "DRAWING SHAPES")
(progn
(setq
PGM_LIST
(list
"Drawing Shapes Program Example 1 (c:XXX1)"
"Drawing Shapes Program Example 2 (c:XXX2)"
"Drawing Shapes Program Example 3 (c:XXX3)"
) ;_ end of list
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
(if (<= (getvar "maxsort") (length PGM_LIST))
(progn
(setq MSORT (getvar "maxsort"))
(setvar "maxsort" (length PGM_LIST))
(setq PGM_LIST (acad_strlsort PGM_LIST))
(setvar "maxsort" MSORT)
) ;_ end of progn
(setq PGM_LIST (acad_strlsort PGM_LIST))
) ;_ end of if
(start_list "pgm_list")
(mapcar 'add_list PGM_LIST)
(end_list)
(setq NO_OF_LSPS (rtos (length PGM_LIST) 2 0))
(set_tile "no_of_lsps" (strcat "Number of Programs : " NO_OF_LSPS))
) ;_ end of defun
(defun
PICK_CATEGORY ()
(setq CATEGORY (nth (atoi CAT_PICK) CATEGORY_LIST))
)
;********************GET Program from List FUNCTION***********************
(defun
GET_PGM_LIST ()
(setq PGM_NUM (atoi (get_tile "pgm_list")))
(setq PGM (nth PGM_NUM PGM_LIST))
(setq LSP_NAME PGM)
)
;********************RUN Program from List FUNCTION***********************
;;Define your Program Equivalants from the "set_pgm_name" List Function above, in order to Execute.
(defun
RUNIT ()
(if (= LSP_NAME "Add a Chart or (Table) to your drawing (c:Table)")
(C:TABLE)
) ;_ end of if
(if (= LSP_NAME "Align Text along (2) Points (c:At)")
(C:AT)
) ;_ end of if
(if (= LSP_NAME "Center a Text string between (2) Points (c:Ct)")
(C:CT)
) ;_ end of if
(if (= LSP_NAME
"Locate the Midpoint of any (2) selected Points (c:H)"
) ;_ end of =
(C:H)
) ;_ end of if
(if (= LSP_NAME "Program Description Example 5 (c:XXX5)")
(C:XXX5)
) ;_ end of if
(if (= LSP_NAME "Program Description Example 6 (c:XXX6)")
(C:XXX6)
) ;_ end of if
(if (= LSP_NAME "Program Description Example 7 (c:XXX7)")
(C:XXX7)
) ;_ end of if
(if (= LSP_NAME "Program Description Example 8 (c:XXX8)")
(C:XXX8)
) ;_ end of if
(if (= LSP_NAME "Program Description Example 9 (c:XXX9)")
(C:XXX9)
) ;_ end of if
(princ)
) ;_ end of defun
(defun
DLG_CHK ()
(if (/= LSP_NAME NIL)
(progn (setq FLAG 1) (done_dialog))
(progn
(setq FLAG t)
(alert
"\nThere is nothing to Execute....\nPlease make a selection from the List!\n\n"
) ;_ end of alert
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
(defun
DLG_MAIN (/ FLAG)
(setvar "cmdecho" 0)
(if (= CATEGORY NIL)
(setq CATEGORY "ALL")
) ;_ end of if
(close (open "temp.dcl" "w"))
(if (not (new_dialog "dlg_main" *LIBID*))
(exit)
) ;_ end of if
(SET_CATEGORY_LIST)
(SET_PGM_NAME)
(action_tile
"cat_lst"
"(setq cat_pick $value)(pick_category)(set_pgm_name)"
) ;_ end of action_tile
(action_tile "pgm_list" "(get_pgm_list)")
(action_tile "run_pgm" "(dlg_chk)")
(action_tile "cancel" "(setq flag 0)(done_dialog)")
(start_dialog)
(if (= FLAG 1)
(RUNIT)
) ;_ end of if
(setq FD (open "symtos.txt" "w"))
(princ "" FD)
(close FD)
(princ)
) ;_ end of defun
;;; Define Error Routine ;;;
(setq LIB_ERR *ERROR*)
(defun-q
*ERROR*
(MSG)
(princ MSG)
(setq FD (open "symtos.txt" "w"))
(princ "" FD)
(close FD)
(setq *ERROR* LIB_ERR)
(princ)
) ;_ end of defun-q
;;; Perform creation of dialog, Load dialog & set global Handle (*libid*) ;;;
(if (not *LIBID*)
;;; first time thru
(progn
(DCL_TEMP)
(if (< (setq *LIBID* (load_dialog "temp.dcl")) 0)
(*ERROR* "Dialog Load Error")
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(DLG_MAIN)
;;; RESTORE ERROR HANDLER AND EXIT ;;;
(terpri)
(*ERROR* "Lib program finished...")
) ;_ end of defun
(princ "Loaded")
(princ)
(princ "\n->Defined command...Lib")
(terpri)
;;;=====================
;;; Degrees to Radius
;;;=====================
(defun DTOR (DEGREE) (* DEGREE (/ pi 180.0)))
;;;=====================
;;; Radius to Degrees
;;;=====================
(defun RTOD (RADIAN) (* RADIAN (/ 180.0 pi)))
;;;=====================================
;;; Check for current version of Autocad
;;;=====================================
(defun
CHK_ACADVER ()
(if (wcmatch (getvar "ACADVER") "*12*")
(setq ACADREL "12")
) ;_ end of If
(if (wcmatch (getvar "ACADVER") "*13*")
(setq ACADREL "13")
) ;_ end of If
(if (wcmatch (getvar "ACADVER") "*14*")
(setq ACADREL "14")
) ;_ end of If
(if (wcmatch (getvar "ACADVER") "*15*")
(setq ACADREL "15")
) ;_ end of If
) ;_ end of defun
;;;=================================================================================
;;; FUNCTIONS TO SETUP LISP ROUTINES FOR AUTO-LOADING THE FIRST TIME THEY ARE
;;; CALLED, EITHER FROM THE COMMAND LINE OR FROM THIS PROGRAM'S LIST BOX EXECUTION.
;;;=================================================================================
;;;Add your custom programs and define their loading functions here...
(defun
C:AT ()
(load "Altext") ;Align text along (2) endpoints
(C:AT)
) ;Has option for vertical & oblique text.
(defun
C:CT ()
(load "Ct") ;Center text between (2) pick points.
(C:CT)
) ;_ end of DEFUN
(defun
C:H ()
(load "Half") ;Divide any (2) pick points in half and place
(C:H)
) ;a node point between them for reference.
(defun
C:TABLE ()
(load "Table") ;Add a Chart or (Table) to your drawing
(C:TABLE)
) ;Uses "dimtxt" and "dimscale" settings
;(DEFUN C:XXX5 ()(Load "XXX5") ;Program Description Example 5
;(c:XXX5))
;(DEFUN C:XXX6 ()(Load "XXX6") ;Program Description Example 6
;(c:XXX6))
;(DEFUN C:XXX7 ()(Load "XXX7") ;Program Description Example 7
;(c:XXX7))
;(DEFUN C:XXX8 ()(Load "XXX8") ;Program Description Example 8
;(c:XXX8))
;(DEFUN C:XXX9 ()(Load "XXX9") ;Program Description Example 9
;(c:XXX9))
(princ)
