Jump to content

Command Table Creating....

harimaddddy

By harimaddddy
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

harimaddddy Apprentice

harimaddddy

Posted
Posted

Hi my friends 👋, Happy day....

 

I'm trying to solve an issue to help my non-coder friends. I'm using a Lisp file that contains all my routines, but I can't explain everything every time. So, I want to create a table inside AutoCAD that lists the shortcut commands and their descriptions, similar to how the TEXT COUNTER command works by Lee Mac. Any other suggestions could help me a lot.

 

Thanks in advance my friends....

 

Attached is my lisp file

Lisp Routine.lsp

Steven P Grand Master

Steven P

Posted
Posted

You need to do a little background work to create the descriptions and once that is done you'll want a way to display on the screen

 

I made a LISP that does similar, all my LISPs are in the same location - can use trusted file locations as well I think - using that folder path you can list all files with a '.lsp' extension:

(vl-directory-files "filepath" "*.lsp" 1)

 

Using that list you can open each file to read, read each line and if it starts with (defun c then the line is the command for a LISP (sorry can't put the ':' in that, stupid auto-emojis). I think Lee Macs 'GetSyntax' will do this.

 

I often find having just the list is enough to jog the memory of a routine to use.

 

For the actual help I add a few lines at the end of the LISP definition, commented out something like

;;MyLispHelp :-: This is the help for a LISP

;;MyLispHelp :-: Shortcut: MLH

;;MyLispHelp :-: Displays some help

 

and using a similar idea to getsyntax, read through the LISP file and record into a LISP anything that is ;;My -LISPNAME- Help :-:, split the line (Lee Mac String to List) using :-: as a deliminator and nth 1 is the help wording.

 

 

So to get the help, I use a DCL, select the LISP name, and DCL is updated with the help associated with it...

 

 

Is that enough to help - weekend - CAD is off - but for starters make up text with each LISPs help details - I'll see if I can adjust mine to take away personal details early next week (can't remember if it is out there, search my name and 'Lisp Help' or 'LH'

  • Thanks 1
Steven P Grand Master

Steven P

Posted
Posted

this might or might not work as it is:

 

No editing done to make it work anywhere else apart from my CAD of course, it is the weekend.

 

All my LISPs are saved in this folder path: 'desktop' "\\AutoCAD\\AutoCAD LISPS\\" so change this line to suit yoursel: (strcat (getdesktop) "\\AutoCAD\\AutoCAD LISPS\\")

 

Help description is in 2 parts, a pointer line such as 

;;help-LH  where the second half of the line (;;LISPHELPLH) is the pointer to the help description. Each line of help starts with this pointer - search it out and see how it works, done this way so that several LISPs can have the same help description.

 

I don't think all the buttons will work, the search button never worked (run out of time)

 

 

Let me know if there are any errors  and what - usually simple fixes

 

  

;;tidy this up Lisphalpa to be removed.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Creates a dialogue box that contains 2 drop down lists
;;The first list contains all the LSP files in a folder. Selecting
;;a file name will list the LISP routines within that file (defined
;;as defun c:...)
;;Selecting a LISP name will run that routine.
;;
;;
;;The option 'View Code' is useful to make quick updates without
;;having to navigate to the LISP library location in the file
;;manager
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(vl-load-com)
(if (strcat (getvar "TEMPPREFIX") "LH.dcl")(vl-file-delete (strcat (getvar "TEMPPREFIX") "LH.dcl")))
(if (strcat (getvar "TEMPPREFIX") "RunLisps.dcl")(vl-file-delete (strcat (getvar "TEMPPREFIX") "RunLisps.dcl")))



;;;;;;;;;;;;;;;;;--START OF REFERENCE LISPS-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; - Refer to Lee Mac Programming for details, the full LISP and the latest versions - ;;;;
;;;; - of functions named 'LM:xxxxxx ()'                                               - ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:GetSyntax ( file / _GetSyntax line syntax )
 (defun _GetSyntax ( p s / x )
  (if (setq x (vl-string-search p s))
   (cons
    (substr (setq s (substr s (+ x 1 (strlen p)))) 1
     (setq x
      (car
       (vl-sort
        (vl-remove 'nil
         (mapcar
          (function
           (lambda ( d ) (vl-string-position d s))
          )
          '(32 9 40 41)
         )
        )
        '<
       )
      )
     )
    )
   (if x (_GetSyntax p (substr s (1+ x))))
   )
  )
 ) 

 (if (setq file (open file "r"))
  (apply 'append
   (progn
    (while (setq line (read-line file))
      (if (or (= (substr line 1 1) ";") (= line nil) ) ; remnove commented out lines & blank lines
        ()
        (progn ;;remove ignored items
          (if (wcmatch (Strcase line) "*DEFUN C:*") ;if line contains a defun
            (progn
              (setq splittext (LM:str->lst line ";")) ; ignore anything after ';'
              (setq line (nth 0 splittext))
              (setq splittext (LM:str->lst line (chr 34))) ; ignore strings '"'
              (setq line "")
              (setq count 0)
              (while ( < count (length splittext))
                (setq line (strcat line (nth count splittext)))
                (setq count (+ count 2))
              ) ; end while
              (setq syntax (cons (_GetSyntax "(DEFUN C:" (strcase line)) syntax))
            ) ; end progn
          ) ; end if

        )
      )
;;     (setq syntax (cons (_GetSyntax "(DEFUN C:" (strcase line)) syntax))
    )
    (setq file (close file)) (reverse syntax)
   )
  )
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:str->lst ( str del / pos ) ;;String to List
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:lst->str ( lst del / str ) ;;List to String
    (setq str (car lst))
    (foreach itm (cdr lst) (setq str (strcat str del itm)))
    str
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:Rlst->str ( lst del / str ) ;;List to string and reverses order. Amended from LM:lst->str()
    (setq str (car lst))
    (foreach itm (cdr lst) (setq str (strcat itm del str))) ;;Reverses list at same time
    str
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Popup box routine
;;From Lee Mac Programming
(defun LM:Popup ( title msg flags / wsh res )
  (if (setq wsh (vlax-create-object "wscript.shell"))
    (progn
      (setq res (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 title flags)))
        (vlax-release-object wsh)
        (if (null (vl-catch-all-error-p res))
          res
      )
    )
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:sendkeys ( keys / wsh ) ;;note can also be used to run a LISP....
  (setq wsh (vlax-create-object "wscript.shell"))
  (vl-catch-all-apply 'vlax-invoke (list wsh 'sendkeys keys))
  (vlax-release-object wsh)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;To find text within a text file.
;;http://www.cadtutor.net/forum/showthread.php?102326-Open-text-file-and-jumping-to-a-line&p=694572#post694572
; example command to call it (NotepadFind "C:\\Downloads\\test 123.txt" "findtext" 300)
(defun NotepadFind (fnm str delay / obj)
  (vl-catch-all-apply
    (function
      (lambda ()
        (setq obj (vlax-get-or-create-object "WScript.Shell"))
        (vlax-invoke obj 'Run (strcat "Notepad.exe \"" fnm "\"")) ;; or notepad++ if that is used.
        (setvar 'cmdecho 0)
        (command "_.delay" delay) ; Milliseconds. For BricsCAD users: (sleep delay) does not work.
        (setvar 'cmdecho 1)
        (vlax-invoke obj 'AppActivate "Notepad++") ; Title bar name of application. ++ for notepad++ but still works?
        (vlax-invoke obj 'SendKeys (strcat "^f" str "{ENTER}{ESC}"))
      )
    )
  )
  (if obj (vlax-release-object obj))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;            --END OF REFERENCE LISPS-                  ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;LISPHELPLH:Help!
;;LISPHELPLH:
;;LISPHELPLH:Keyboard Commands "LispHelp", "LH"
;;LISPHELPLH:
;;LISPHELPLH:Description:
;;LISPHELPLH:Shows help, tips and tricks for a selected LISP routine
;;LISPHELPLH:Select either the file the LISP is saved in and its name
;;LISPHELPLH:from the top drop down boxes or scroll through the lower
;;LISPHELPLH:menu list box to find the required LISP. Clicking on the
;;LISPHELPLH:LISP name will show any help available for that LISP.
;;LISPHELPLH:
;;LISPHELPLH:Tip: Select the lower menu list and type the first letter
;;LISPHELPLH:of your selected LISP routine to jump to LISPs starting
;;LISPHELPLH:with that character.
;;LISPHELPLH:
;;LISPHELPLH:There are options to change the LISP library location, 
;;LISPHELPLH:to run the selected LISP or to view the LISP code.
;;LISPHELPLH:
;;LISPHELPLH:Notes:
;;LISPHELPLH:If your selecting a LISP from the upper drop down box (by
;;LISPHELPLH:selecting its file) then you need to select a LISP in the
;;LISPHELPLH:second box - even if it shows the LISP you want by default.
;;LISPHELPLH:Similarly to use the 'Run Lisp' and 'View Code' opteions
;;LISPHELPLH:a LISP needs to be selected
;;LISPHELPLH:
;;LISPHELPLH:
;;LISPHELPLH:Note:
;;LISPHELPLH:The help descriptions are saved in the file for that LISP
;;LISPHELPLH:as a block of text. They are identified with each line of
;;LISPHELPLH:help preceded with text in the format ";;XYZHelp:" where
;;LISPHELPLH:'XYZ' is the LISP name. XYZ needs to be in uppercase.

;;help-LH ;;LISPHELPHelp
;;help-LISPHELP ;;LISPHELPHelp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;












;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;When a different *.lsp file is selected, changes the lisps;;
;;drop down list contents
(defun SP:updatelisps( spLispFolder splispfiles / lispsreturn mylispfiles myfile mylisps lisps )
;;(defun SP:updatelisps( spLispFolder splispfiles / )

  (setq y nil)
  (setq y (read (get_tile "lispfiles")))
  (setq mylispfiles (vl-directory-files mylispfolder "*.lsp" nil))

  (setq myfile (strcat mylispfolder (nth (+ y 1) mylispfiles))) ; adjusted to -1 to 'hide' index LISP
  (setq mylisps (LM:getsyntax myfile))
  (setq mylisps (vl-remove "\"" mylisps)) ;;to remove defined items from the list. Example, it picks up 'defun c:"' in programming as lisp '"'

  (setq mylisps (vl-sort mylisps '<)) ;;sorts the list
  (start_list "lisps" 3)(mapcar 'add_list mylisps)(end_list) ;;create Lisps list
;;  lisps

  (setq lispsreturn (list lisps mylispfiles myfile mylisps))

  lispsreturn
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SP:selectfolder( / SFMyDir SFLispFiles)
  (setq SFMyDir (LM:browseforfolder "Select a folder" "SFMyDir" 0))
  (if (/= SFMyDir Nil) ;;if folder selection wasn't cancelled
    (progn
      (set_tile "foldertext" SFMyDir)
      (setq SFMyDir (strcat SFMyDir "\\"))
      (setq SFLispFiles (vl-directory-files SFMyDir "*.lsp" nil)) ;;runlispfiles is the list of files in runlispdir location

      (setq lispfiles nil)
      (start_list "lispfiles" 3)(mapcar 'add_list SFLispFiles)(end_list) ;;create Lisp files list
      (setq z (read (get_tile "lispfiles")))

      (setq myfile (strcat SFMyDir (nth z SFLispFiles)))
      (setq mylisps (LM:getsyntax myfile))
      (SP:lisplist SFMyDir)

      (start_list "AllLisps" 3)(mapcar 'add_list allthelisps)(end_list);;create Lisp files list
      (setq mylispfolder SFMyDir)
      (setq runlispfiles SFLispFiles)
    );;end progn
  );; end if
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;creates a text box pop up listing all the lisp routines in;;
;;*.lsp files in the location below                         ;;
(defun SP:lisplist ( lisplistfolder / SortedLisps SortedFiles SortedListLength SortedCount)

  (setq allthelisps nil)
  (setq mylispfileslist nil)
  (setq mylispfileslist "")

;;  (setq mylispfiles (vl-directory-files lisplistfolder "*.lsp" nil)) ;;mylispfiles is list of files in mylispfolder location
  (setq mylispfiles (GetMyLispFiles))

  (setq mylistlength (length mylispfiles)) ;;count of number of lsp files
  (setq acount -1)

  (setq myroutines "")

  (repeat mylistlength
    (setq acount (1+ acount))
    (setq myfilename (strcat lisplistfolder (nth acount mylispfiles)))

    (progn
      (if (not (mapcar '(lambda ( x ) (princ)) (setq mylisplist (LM:GetSyntax myfilename)))) ;;puts list into an array
        (princ "\n -None-\n")
      )

      (setq mylisplist (vl-remove "\"" mylisplist)) ;;to remove defined items from the array.
      (foreach n mylisplist                         ;;loops through array
        (progn
          (setq allthelisps (cons n allthelisps))         ;;All the lisps is a list of all the lisps
          (setq mylispfileslist (cons myfilename mylispfileslist)) ;;generates a list of files coresponding to the LISPS
        ) ; end progn
      ) ; end foreach
    )
  )


  (setq SortedLisps (vl-sort allthelisps '<)) ;;sorts the list
  (setq SortedListLength (vl-list-length SortedLisps))
  (setq SortedCount 0)

;;Sorts the lisp files list
;;  (while (<= (1+ SortedCount) (vl-list-length SortedLisps))

  (while (<= (+ SortedCount 1) (vl-list-length SortedLisps))

    (setq LLFilePath (nth (vl-position (nth SortedCount SortedLisps) allthelisps) mylispfileslist)) ;;make into a list
    (setq SortedFiles (cons LLFilePath SortedFiles)) ;;generates a list of files coresponding to the LISPS
;;    (setq SortedCount (1+ SortedCount))
    (setq SortedCount (+ SortedCount 1))
  )

  (setq allthelisps SortedLisps)
  (setq mylispfileslist (reverse SortedFiles))
;;  (textpage) ;; Display textpage command thing


  (setq lisplist (list allthelisps mylispfileslist))
  lisplist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lisphelpa( / HelpLispLocation HelpLispFile HelpLispFilename HelpLispRoutine textstring HelptextOne)
;;for LISP List sorted by file

  (setq HelpLispLocation mylispfolder) ;;LISP File Location and Name remember double \\s
  (setq HelpLispFilename "TEXTLISPS.lsp") ;;LISP File Location and Name
  (setq HelpLispFile myfile)

  (setq MyLispName (read (get_tile "lisps"))) ;;this is the LISP routine position in the list.
  (if (= MyLispName nil) (setq MyLispName 0)) ;;in case no LISP was selected, chooses 1st in list
  (setq alisp (strcat (nth MyLispName mylisps))) ;;lisp routine name

  (setq helpstring (strcat ";;help-" alisp " "))
  (setq textstring (strcat (LM:lst->str (SP:ReadFile HelpLispFile helpstring) "") ":") ) ;;now add helpstrings to all lips
  (setq HelpText (SP:ReadFile HelpLispFile TextString));;Calls text reading routine
  (setq HelpText (cons (strcat "Command: " alisp) HelpText))

  (start_list "DCLHELPTEXT" 3)(mapcar 'add_list HelpText)(end_list)


)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun alllisphelp( / HelpLispLocation HelpLispFile HelpLispFilename HelpLispRoutine textstring HelptextOne helpstring)
;;for LISP list sorted by whole folder

  (setq lastlistselection "Alllisplist")
  (setq HelpLispLocation mylispfolder) ;;LISP File Location and Name remeber double \\s
  (setq MyAllLispPosition (read(get_tile "AllLisps"))) ;;this is the LISP routine name.

  (setq lastlistselection "Alllisplist")
  (setq MyLispName (nth MyAllLispPosition allthelisps))
  (setq mynewfile (nth MyAllLispPosition mylispfileslist))

;;;;Search for ';;help-[command-name]'
;;;; string format ';;help-[command-name] ;;[COMMAND-NAME]help:'
;;;;-add checks if file and string doesn't exist
  (setq helpstring (strcat ";;help-" MyLispName " "))

  (setq textstring (strcat (LM:lst->str (SP:ReadFile mynewfile helpstring) "") ":") ) ;;now add helpstrings to all lips
  (setq HelpText (SP:ReadFile mynewfile TextString));;Calls text reading routine

  (setq HelpText (cons (strcat "Command: " MyLispName) HelpText))
  (setq HelpText (cons (strcat "Lisp File: " (vl-filename-base mynewfile) ".LSP" ) HelpText))
;;  (setq HelpText (append (list (car (reverse (LM:str->lst mynewfile "\\")))) HelpText ))

;;  (LM:Popup "LISP Help" (LM:lst->str HelpText "") (+ 0 256)) ;;text has to be a string, not a list. Help as a popup box.
  (start_list "DCLHELPTEXT" 3)(mapcar 'add_list HelpText)(end_list)






)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SP:ReadFile (HelpLispFile TextString / HelpFile HelpList HelpLine)
;;Read File
  (and
    (setq HelpFile (open (findfile HelpLispFile) "R"))
    (while (setq HelpLine (read-line HelpFile))
      (if (vl-string-search TextString HelpLine)
          (setq HelpList (cons HelpLine HelpList))
      ) ;_ if
    ) ;_ while
    (close HelpFile)
  ) ;_ and

;;If there is no help text accosciated with the LISP do this:
  (if (= HelpList nil)
    (progn
      (setq TextString "STARTLINE")
      (setq HelpList (cons "STARTLINE" HelpList))
      (setq HelpList (cons "STARTLINEThere is no help available for this LISP routine" HelpList))
      (setq HelpList (cons "STARTLINE" HelpList))
      (setq HelpList (cons "STARTLINE" HelpList))
      (setq HelpList (cons "STARTLINENotes: None" HelpList))
    )
  )

;;Remove deliminator
  (setq HelpList (LM:Rlst->str HelpList "\n")) ;;Adds in a new line between text items
  (setq HelpList (LM:str->lst HelpList TextString)) ;;removes text search item and reverses list order
;;  (setq HelpListLength (1- (length HelpList))) ;;Not needed, just in case needed for future


  HelpList
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





(defun SP:ShowLISP(MyText)
;;Make this work
;;Get typed in LISP name
;;Check it is a valid LISP
;;get the related LISP file name
;;Display the Help text for that

;;  (setq allthelisps SortedLisps)
;;  (setq mylispfileslist (reverse SortedFiles))
;;  (set_tile "TypeLisp" (strcat "Done " MyText))
;;(setq lisposition (vl-string-search MyText allthelisps))
;;(set_tile "TypeLisp" (member MyText allthelisps))

(setq MyTextPosition (vl-string-search MyText (LM:lst->str allthelisps " "))) ;;gives position. Need MyText as uppercase


(set_tile "TypeLisp" "Done")

;;(princ (+1 MyTextPosition))

)





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;When a lisp routine is selected or OK pressed
(defun RL:runlisp ()

;;Add in here check if anything was selected

  (setq runlisp "Yes")
  (setq popupvalue (read (get_tile "lisps")))
  (setq alisp (strcat "c:" (nth popupvalue mylisps)))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(defun ViewCode ( VCMyLispFolder VCLastListSelection / VCListPosition VCLispPosition) ;;'VC'.. strings for this LISP
;
;  (setq VCMyFile (strcat VCMyLispFolder "LISPSHELP.lsp")) ;;default if nothing is selected.
;  (setq VCMyLisp "LH") ;;default if nothing is selected
;
;  (if (= VCLastListSelection "byfolder")
;    (progn
;      (setq VCListPosition (read (get_tile "lispfiles")))
;      (setq VCMyFile (strcat VCMyLispFolder (nth VCListPosition mylispfiles)))
;      
;      (setq VCLispPosition (read (get_tile "lisps")))
;      (setq VCMyLisp (nth VCLispPosition mylisps))
;    )
;  )
;
;  (if (= VCLastListSelection "Alllisplist")
;    (progn
;      (setq VCListPosition (read (get_tile "AllLisps")))
;      (setq VCMyFile (strcat (nth VCListPosition mylispfileslist)))
;      
;      (setq VCLispPosition (read (get_tile "AllLisps")))
;      (setq VCMyLisp (nth VCLispPosition allthelisps))
;    )
;  )
;
;  (if (= (findfile VCMyfile) nil)(LM:Popup "Select a file" "Please select a file or LISP from the lists" 256))
;  (setq ViewCode "yes") ;;opens noteped, finds code
;
;;;  ViewCode
;
;)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ViewCodea ( VCMyLispFolder VCLastListSelection / VCListPosition VCLispPosition) ;;'VC'.. strings for this LISP

  (setq VCMyFile (strcat VCMyLispFolder "LISPSHELP.lsp")) ;;default if nothing is selected.
  (setq VCMyLisp "LH") ;;default if nothing is selected

  (if (= VCLastListSelection "byfolder")
    (progn
      (setq VCListPosition (read (get_tile "lispfiles")))
      (setq VCMyFile (strcat VCMyLispFolder (nth VCListPosition mylispfiles)))
      
      (setq VCLispPosition (read (get_tile "lisps")))
      (setq VCMyLisp (nth VCLispPosition mylisps))
    )
  )

  (if (= VCLastListSelection "Alllisplist")
    (progn
      (setq VCListPosition (read (get_tile "AllLisps")))
      (setq VCMyFile (strcat (nth VCListPosition mylispfileslist)))
      
      (setq VCLispPosition (read (get_tile "AllLisps")))
      (setq VCMyLisp (nth VCLispPosition allthelisps))
    )
  )


  (if (= (findfile VCMyfile) nil)(LM:Popup "Select a file" "Please select a file or LISP from the lists" 256))
  (setq ViewCode "yes") ;;opens noteped, finds code

  ViewCode

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun LH:RunLisp( RLMyLispFolder RLLastListSelection / RLListPosition RLMyFile RLALisp ifselection)

  (setq ifselection 0)
  (if (>= (get_tile "lisps") "0") (setq ifselection (+ ifselection 1)))
  (if (>= (get_tile "AllLisps") "0") (setq ifselection (+ ifselection 1)))
  (if (> ifselection 0)
  (progn
    (if (= RLLastListSelection "byfolder")
      (progn
      ;;get file name
        (setq RLListPosition (read (get_tile "lispfiles")))
        (if (= RLListPosition nil) (setq RLListPosition 1)) ;;in case no LISP was selected, chooses 1st in list
        (setq RLMyFile (strcat RLMyLispFolder (nth RLListPosition mylispfiles)))
      ;;get lisp name    
        (setq RLListPosition (read (get_tile "lisps"))) ;;this is the LISP routine name.
        (if (= RLListPosition nil) (setq RLListPosition 0)) ;;in case no LISP was selected, chooses 1st in list
        (setq RLALisp (strcat "c:" (nth RLListPosition mylisps)))
      )
      (setq runlisp "yes")
    )
  
    (if (= RLLastListSelection "Alllisplist")
      (progn
      ;;get lisp name    
        (setq RLListPosition (read (get_tile "AllLisps"))) ;;this is the LISP routine name.
        (if (= RLListPosition nil) (setq RLListPosition 0)) ;;in case no LISP was selected, chooses 1st in list
        (setq RLALisp (strcat "c:" (nth RLListPosition allthelisps)))
      ;;get file name
        (setq RLMyFile  (strcat (nth RLListPosition mylispfileslist)))
      )
      (setq runlisp "yes")
    )
  
    (setq alisp RLALisp) ;;alisp used elsewhere after this
    (setq runlisp runlisp) ;;runlisp used elsewhere
  );;end progn
  );;end if

  (if (= runlisp "yes")
    (progn
      (princ "\n")
      (princ alisp)
      (princ ": ")
      (load RLMyFile)
;;      (eval (list (read alisp))) ;;run the lisp.. can't get this line to run from here - need to close the dialog box first
    )
  )
  (if (= runlisp "no")
    (progn
      (princ)
    )
  )

  (if (= ifselection 0)
    (progn
      (LM:Popup "No Selection" "No Lisp routine was selected." 256)
      (LM:SendKeys "LH{ENTER}") ;;re-runs LH
;;      (princ "\nNo lisp selected")
    )
  )

  runlisp

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Creates a pop up box listing the *.lsp files and the lips ;;
;;routines within that file                                 ;;
;;Selecting a lisp routine name will run that lisp routine  ;;
(defun c:RunLisp ( / dcl des dch)

;;Initial values
  (setq runlisp (GetrunLisp))
  (setq mylispfolder (GetMyLispFolder))
  (setq mylispfiles (GetMyLispFiles)) ;;list of files in mylispfolder location.
  (setq lastlistselection (GetLastListSelection))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;create DCL pop up box                                      ::

  (if
    (and
;;      (setq dcl (vl-filename-mktemp nil nil ".dcl"))
(setq dcl (strcat (getvar "TEMPPREFIX") "RunLisps.dcl"))
      (setq des (open dcl "w"))
      (foreach x
        '(
"           pass : dialog"
"           {"
"             key = \"Lispdialoguebox\";"
"             label = \"RUN LISP\";"
"             spacer;"

"             : boxed_column { label = \"Select LISP Routine\";"
"               : row { width = 60; alignment = centered;"
"                 : column {width = 20; alignment = centered;"
"                   :row {alignment = bottom;"
"                     : text { key = \"filetext\"; label = \"File Name\"; width = 20; alignment = right;}"
"                   }"
"                 }"
"                 : column {width = 40; alignment = left;"
"                   : popup_list { key = \"lispfiles\"; width = 40; multiple_select = true ; alignment = left; }"
"                 }"
"               }"

"               : row { width = 60; alignment = centered;"
"                 : column {width = 20; alignment = centered;"
"                   :row {alignment = bottom;"
"                     : text { key = \"Lisptext\"; label = \"Lisp Name\"; width = 20; alignment = right;}"
"                   }"
"                 }"
"                 : column {width = 40; alignment = left;"
"                   : popup_list { key = \"lisps\"; width = 40; multiple_select = true ; alignment = left; allow_accept = true;}"
"                 }"
"               }"
"               : row {"
"                 : button { key = \"folder\"; label = \"Change Lisp Library\"; is_default = false; fixed_width = true; width = 5;}"
"                 : text { key = \"foldertext\"; label = \"Folder Location\"; width = 40; }"
"                 spacer;"
"               }"
"             }"
"             : boxed_column { width = 60; alignment = left;"
"               : row {"
"                 : column {width = 18; alignment = centered;"
"                   : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }"
"                 }"
"                 : column {width = 18; alignment = centered;"
"                   : button { key = \"cancel\"; label = \"Cancel\"; is_default = false; is_cancel = true; fixed_width = true; width = 15; }"
"                 }"
"               }"
"             }"
"           }"
          )
        (write-line x des)
      )
      (not (setq des (close des)))
      (< 0 (setq dch (load_dialog dcl)))
      (new_dialog "pass" dch)
    )
    (progn
;;End of DCL pop up box                                      ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;makes a pop-up list box
;;;;      (setq runlispfiles (cons " " runlispfiles)) ;;adds blank to start of list. Need to add checks if anything was selected
      (start_list "lispfiles" 3)(mapcar 'add_list mylispfiles)(end_list);;create Lisp files list
      (set_tile "foldertext" mylispfolder)

      (action_tile "lispfiles" "(setq lisps (SP:updatelisps mylispfolder (read (get_tile \"lispfiles\"))))")
      (action_tile "lispfiles" "(setq nthlisps (SP:updatelisps mylispfolder (read (get_tile \"lispfiles\"))))
                            (setq lisps (nth 0 nthlisps))
                            (setq mylispfiles (nth 1 nthlisps))
                            (setq myfile (nth 2 nthlisps))
                            (setq mylisps (nth 3 nthlisps))
  "
  )
;;(setq lispsreturn (list lisps mylispfiles myfile mylisps))


      (action_tile "folder" "(SP:selectfolder)")

;; RLMyLispFolder RLLastListSelection 
(setq lastlistselection "Alllisplist") ;;set this to whatever
;;      (action_tile "lisps" "(LH:RunLisp mylispfolder lastlistselection)(done_dialog 1)")

      (action_tile "accept" "(RL:runlisp)(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")

      (start_dialog)
    ) ;;end of DCL 'and' above
    (princ "\nError. Unable to load dialogue box.")
  ) ;;end of DCL 'if' above
  (vl-file-delete dcl) ;;delete the temp DCL file

  (if (= runlisp "Yes")
    (progn
      (load myfile)  ;;try something like (if (not yourdefun)(load "yourlisp")) to trap errors / only load lisp where required
      (princ "\n")
      (princ alisp)
      (princ ": ")
      (eval (list (read (strcat "c:" alisp)))) ;;run the lisp
    )
  )

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;RUNLISPHelp:Keyboard Command "RunLisp"
;;RUNLISPHelp:
;;RUNLISPHelp:Gives the user a dialogue box to select and run a lisp
;;RUNLISPHelp:Lisps are listed by the file that they are saved in
;;RUNLISPHelp:
;;RUNLISPHelp:Notes: None

;;help-RUNLISP ;;RUNLISPHelp













;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Creates a pop up box listing the *.lsp files and the lips ;;
;;routines within that file                                 ;;
(defun c:LH( / butttext VCMyReturn ViewCode VCMyFile VCMyLisp runlisp alisp myfile)

  (if (strcat (getvar "TEMPPREFIX") "LH.dcl")(vl-file-delete (strcat (getvar "TEMPPREFIX") "LH.dcl")))

  (setq butttext (list "Run Lisp" "View Code" "Done" "Output List")) 
  (setq VCMyReturn (list result VCMyFile VCMyLisp alisp myfile mylispfolder))
  (setq VCMyReturn (lisphelp butttext (GetMyLispFolder)) )
  (setq result (nth 0 VCMyReturn))

  (setq VCMyFile (nth 1 VCMyReturn))
  (setq VCMyLisp (nth 2 VCMyReturn))
  (setq alisp (nth 3 VCMyReturn))
  (setq myfile (nth 4 VCMyReturn))

  (setq mylispfolder (nth 5 VCMyReturn))

  (if (= result "butt0")
    (progn
      (princ "\n")
      (princ alisp)
      (princ ": ")
;;      (load myfile)
       (eval (list (read alisp))) ;;run the lisp
    )
  )
  (if (= result "butt1")(NotepadFind VCMyFile (strcat "defun c:" VCMyLisp) 300)) ;;put this outside dialog box
  (if (= result "butt2")(princ "OK\n"))


;;(princ (vl-position selectedlispname (nth 0 LispList)) )
  (princ)
  (nth 2 VCMyReturn) ;;Selected LISP
)


(defun lisphelp ( Butttext mylispfolder / fo fname dcl_id butt0 butt1 butt2 ) ;;ADD: mylispfiles

;;Initial values
  (setq runlisp (GetRunLisp))
  (setq ViewCode (GetViewLisp))
  (setq mylispfiles (GetMyLispFiles)) ;;list of files in mylispfolder location.
  (setq lastlistselection (GetLastListSelection))

  (setq MyLispName nil)
  (setq result "butt2")
  (setq VCMyLisp "")
  (setq VCMyFile "")


  (setq fo (open (setq fname (vl-filename-mktemp "LH" (getvar "TEMPPREFIX") ".dcl")) "w"))
;;  (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))

(write-line "ddgetvalAH : dialog {" fo)
(write-line "  key = \"Lispdialoguebox\";" fo)
(write-line "  label = \"LISP HELP\";" fo)
(write-line "  spacer;" fo)
(write-line " :row {alignment = top;" fo)

(write-line "   :boxed_column { label = \"\"; label = \"Select LISP\"; " fo)
(write-line "     :row {alignment = top;" fo)
(write-line "       :text { key = \"filetext\"; label = \"Browse by LISP File\"; width = 20; alignment = right;}" fo)
(write-line "     }" fo)
(write-line "     :row {alignment = top;" fo)

(write-line "       :column { width = 5;" fo)
(write-line "         : text { key = \"File\"; label = \"File Name\"; width = 5; alignment = left;}" fo)
(write-line "       }" fo)
(write-line "       :column { width = 22;" fo)
(write-line "         :popup_list { key = \"lispfiles\"; width = 20; multiple_select = true ; alignment = left; }" fo)

(write-line "       }" fo)
(write-line "       :column { width = 3;" fo)
(write-line "       }" fo)
(write-line "     }" fo)
(write-line "    :row {alignment = top;" fo)

(write-line "      :column { width = 5;" fo)
(write-line "        : text { key = \"Lisp\"; label = \"Lisp Name\"; width = 5; alignment = left;}" fo)
(write-line "      }" fo)
(write-line "      :column { width = 22;" fo)
(write-line "        :popup_list { key = \"lisps\"; width = 20; multiple_select = true ; alignment = left; allow_accept = true;}" fo)

(write-line "      }" fo)
(write-line "      :column { width = 3;" fo)
(write-line "      }" fo)
(write-line "    }" fo)
(write-line "    :row {alignment = top;" fo)

(write-line "    }" fo)
(write-line "    :row {alignment = middle;" fo)
(write-line "      :text { key = \"OR1\"; label = \"OR\"; width = 20; alignment = right;}" fo)
(write-line "    }" fo)
(write-line "    :row {alignment = top;" fo)

(write-line "      :column { width = 5;" fo)
(write-line "        :row {alignment = middle;" fo)
(write-line "          :text { key = \"CompleteList\"; label = \"Choose Lisp\"; width = 5; alignment = left;}" fo)
(write-line "        }" fo)
(write-line "        :row {alignment = middle;" fo)
(write-line "          : edit_box { key = \"multiletters\"; width = 5; fixed_width = true;}" fo)
(write-line "        }" fo)
(write-line "        :row {alignment = middle;" fo)
(write-line "        }" fo)
(write-line "      }" fo)

(write-line "      :column { width = 22;" fo)
(write-line "        :list_box { key = \"AllLisps\"; height = 10; fixed_height = true; width = 22; fixed_width = true; allow_accept = true;}" fo)

(write-line "      }" fo)
(write-line "      :column { width = 3;" fo)
(write-line "      }" fo)
(write-line "    }" fo)
(write-line "    :boxed_column { label = \"\"; width = 30;" fo)

(write-line "      :row {" fo)
(write-line "        :button { key = \"folder\"; label = \"Change Lisp Library\"; is_default = false; fixed_width = true; width = 5;}" fo)
(write-line "      }" fo)
(write-line "      :row {" fo)
(write-line "        :text { key = \"foldertext\"; label = \"Folder Location\"; width = 30; }" fo)

(write-line "        spacer;" fo)
(write-line "      }" fo)
(write-line "    }" fo)
(write-line "    :boxed_column { label = \"Close this dialogue box and...\"; width = 30; " fo)
(write-line "      :row {alignment = top; wisth = 30; " fo)

(if (/= "NA" (nth 0 Butttext))(write-line (strcat ":button { key = \"Butt0\"; label = \"" (nth 0 Butttext)" \"; is_default = false; fixed_width = true; is_cancel = true; width = 15; }") fo))
(if (/= "NA" (nth 1 Butttext))(write-line (strcat ":button { key = \"Butt1\"; label = \"" (nth 1 Butttext)" \"; is_default = false; fixed_width = true; is_cancel = true; width = 15; }") fo))

(write-line "      }" fo)
(write-line "      :row {alignment = top; width = 20;" fo)

(if (/= "NA" (nth 2 Butttext))(write-line (strcat ":button { key = \"Butt2\"; label = \"" (nth 2 Butttext)" \"; is_default = false; fixed_width = true; is_cancel = true; width = 15; }") fo))
(if (/= "NA" (nth 3 Butttext))(write-line (strcat ":button { key = \"Butt3\"; label = \"" (nth 3 Butttext)" \"; is_default = false; fixed_width = true; is_cancel = true; width = 15; }") fo))

(write-line "      }" fo)
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "    :boxed_column { label = \"\"; width = 50;" fo)
(write-line "      :list_box {key = \"DCLHELPTEXT\"; height = 30; fixed_height = true; width = 50; fixed_width = true;}" fo)

(write-line "    }" fo)
(write-line "  }" fo)
(write-line "}" fo)
  (close fo)

  (setq dcl_id (load_dialog fname))
  (if (not (new_dialog "ddgetvalAH" dcl_id))
    (exit)
  )

;;  (setq mylispfiles (vl-directory-files mylispfolder "*.lsp" nil))
  (setq mylispfiles (GetMyLispFiles))
  (setq myList1 (list "Please select Lisp routine" "from lists on the left" "to display any help or notes"))

  (setq lisplist (SP:LispList mylispfolder)) ;;get list of lisps and populate DCL box list  ;;----;;
;;(setq lisplist (list allthelisps mylispfileslist))
;;(princ allthelisps) ;;list all the lisps in the command line
  (set_tile "foldertext" mylispfolder)

  (start_list "lispfiles" 3)(mapcar 'add_list mylispfiles)(end_list);;create Lisp files list
;;  (start_list "AllLisps" 3)(mapcar 'add_list allthelisps)(end_list);;create Lisp files list
  (start_list "AllLisps" 3)(mapcar 'add_list (nth 0 lisplist))(end_list);;create Lisp files list
  (start_list "DCLHELPTEXT" 3)(mapcar 'add_list myList1)(end_list)

  (action_tile "lispfiles" "(setq nthlisps (SP:updatelisps mylispfolder (read (get_tile \"lispfiles\"))))
                            (setq lisps (nth 0 nthlisps))
                            (setq mylispfiles (nth 1 nthlisps))
                            (setq myfile (nth 2 nthlisps))
                            (setq mylisps (nth 3 nthlisps))
  "
  )

  (action_tile "lisps"     "(setq selectedlispname (nth (atoi (get_tile \"lisps\")) mylisps) )
                            (setq item (set_tile \"AllLisps\" (rtos (vl-position selectedlispname (nth 0 LispList))) ))(alllisphelp)"
  )

  (action_tile "ShowLISP"  "(SP:ShowLISP (get_tile \"TypeLisp\"))")

;;;;;;;;
;;  (action_tile "multiletters"  "(princ (vl-position (get_tile \"multiletters\") mylisps))")
  (action_tile "multiletters"  "(setq multibear (get_tile \"multiletters\"))")
;;;;;;;;


  (action_tile "folder"    "(SP:selectfolder)") ;;if you cancel selecting a folder it cancels this as well, not just folder selection
  (action_tile "AllLisps"  "(alllisphelp)")

  (action_tile "Butt0"  "(setq Butt0 (LH:RunLisp mylispfolder lastlistselection))(done_dialog 1)")
  (action_tile "Butt1"  "(ViewCodea mylispfolder lastlistselection)(setq Butt1 \"yes\")(done_dialog 1)")
  (action_tile "Butt2"  "(setq Butt2 \"yes\")(done_dialog 0)")
  (action_tile "Butt3"  "(sp:lisplisttofile allthelisps mylispfileslist)(done_dialog 1)")
  (action_tile "OK"     "(done_dialog 1)")




  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete fname)

(if (= "yes" Butt0)(setq result "butt0"))
(if (= "yes" Butt1)(setq result "butt1"))
(if (= "yes" Butt2)(setq result "butt2"))

  (setq VCMyReturn (list result VCMyFile VCMyLisp alisp myfile mylispfolder))

  VCMyReturn

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;LISPHELPLH:Help!
;;LISPHELPLH:
;;LISPHELPLH:Keyboard Commands "LispHelp", "LH"
;;LISPHELPLH:
;;LISPHELPLH:Description:
;;LISPHELPLH:Shows help, tips and tricks for a selected LISP routine
;;LISPHELPLH:Select either the file the LISP is saved in and its name
;;LISPHELPLH:from the top drop down boxes or scroll through the lower
;;LISPHELPLH:menu list box to find the required LISP. Clicking on the
;;LISPHELPLH:LISP name will show any help available for that LISP.
;;LISPHELPLH:
;;LISPHELPLH:Tip: Select the lower menu list and type the first letter
;;LISPHELPLH:of your selected LISP routine to jump to LISPs starting
;;LISPHELPLH:with that character.
;;LISPHELPLH:
;;LISPHELPLH:There are options to change the LISP library location, 
;;LISPHELPLH:to run the selected LISP or to view the LISP code.
;;LISPHELPLH:
;;LISPHELPLH:Notes:
;;LISPHELPLH:If your selecting a LISP from the upper drop down box (by
;;LISPHELPLH:selecting its file) then you need to select a LISP in the
;;LISPHELPLH:second box - even if it shows the LISP you want by default.
;;LISPHELPLH:Similarly to use the 'Run Lisp' and 'View Code' opteions
;;LISPHELPLH:a LISP needs to be selected
;;LISPHELPLH:
;;LISPHELPLH:
;;LISPHELPLH:Note:
;;LISPHELPLH:The help descriptions are saved in the file for that LISP
;;LISPHELPLH:as a block of text. They are identified with each line of
;;LISPHELPLH:help preceded with text in the format ";;XYZHelp:" where
;;LISPHELPLH:'XYZ' is the LISP name. XYZ needs to be in uppercase.

;;help-lh ;;LISPHELPLH


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;










;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetRunLisp(/ RL)
  (setq RL "No")
  RL  
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetViewLisp(/ VL)
  (setq VL "No")
  VL  
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetMyLispFolder( / MILFO)
  (defun GetDesktop ( / script spFolders desktop)
    (cond (
      (setq script (vlax-create-object "WScript.Shell"))
      (setq spFolders (vlax-get-property script "SpecialFolders")
            desktop   (vlax-invoke-method spFolders 'Item "Desktop")
      )
      (vlax-release-object spFolders)
      (vlax-release-object script)
      )
    )
    desktop
  )

  (setq MILFO (strcat (getdesktop) "\\AutoCAD\\AutoCAD LISPS\\"))
;;  (setq MILFO "c:\\")
  MILFO
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetMyLispFiles ( / MILF MILFI exceptions)
  (setq exceptions (list "0_OpenOnDemand.lsp"))

  (setq MILFI (vl-directory-files (GetMyLispFolder) "*.lsp" nil))
  (foreach n exceptions
    (setq MILFI (vl-remove n MILFI))
  ) ; end foreach

  MILFI
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetLastListSelection( / LLS)
  (setq LLS "LH")
  LLS
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sp:lisplisttofile ( lispslist mylispfileslist / lfcount txt1 txt1a txt2 txt2a txt2b txt3 txt4) ;;creates list of LISPs to notepad
  (defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
  )
  (defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
  )


  (if (strcat (getvar "TEMPPREFIX") "LispList.txt")(vl-file-delete (strcat (getvar "TEMPPREFIX") "LispList.txt")))
  (setq Lispfile (strcat (getvar "TEMPPREFIX") "LispList.txt"))

  (setq txt1 "(defun c:" )
  (setq txt2 " ( / )" )
  (setq txt3 "  (load \"" )
  (setq txt4 "\") " )
  (setq txt5 " (princ)" )
  (setq txt6 ")" )

  (setq lfcount 0)
  (setq LFDES (open Lispfile "w"))
;;  (foreach x lispslist
;;    (write-line x LFDES)
;;  ) ; end foreach

  (while (< lfcount (min (length lispslist) (length mylispfileslist)))

    (write-line (strcat (nth lfcount lispslist) "\t" (nth lfcount mylispfileslist)) LFDES)

;    (setq txt1a (nth lfcount lispslist) )
;    (setq txt3a (LM:str->lst (nth lfcount mylispfileslist) "\\"))
;    (setq txt3b (LM:lst->str txt3a "\\\\"))
;    (write-line (strcat txt1 txt1a txt2 ) LFDES)
;    (write-line (strcat txt3 txt3b txt4 txt1a txt5 ) LFDES)
;    (write-line (strcat txt6 ) LFDES)

    (setq lfcount (+ lfcount 1))
  ) ; end while
  (write-line (strcat "LISP Routines: " (rtos (length lispslist) 2 0 )) LFDES)
  (setq LFDES (close LFDES))
  (if (findfile Lispfile) (startapp "notepad" Lispfile))
  (if (not (findfile Lispfile)) (princ "\nError writing file"))

  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...