home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SEP93CAD.ZIP / TIP899.LSP < prev   
Lisp/Scheme  |  1993-08-31  |  6KB  |  115 lines
  1. ;TIP #899:  VSLD1.LSP   Insert Manager   (c)1993, Terry Priest
  2.  
  3.  
  4. ; Copyright from 8-90 by Terry Priest 
  5. ; The user needs to implement **DIRS and **BLANK.
  6. ; This is the abbreviated version of VSLD or VSLDLITE. The full featured
  7. ; version (with Dos functions) is on Cserve.
  8. ;*****************************************************************************
  9. ;Global variables: fls, path, flage, flagsv
  10. (defun C:VSLD1 (/ fl pageno readno scrlen pages pathln)
  11.    (setq scrlen 20) ;change screen length here to match your display's # of lines
  12.    (if fls (setq pathln (dirlen (car fls)))
  13.    (setq path (getdir path) fls (getdwg path) pathln (1+ (strlen path))))
  14.    (setq pageno 0  pages (pag#s fls scrlen))
  15.    (menucmd "S=BLANK")                ;**Blank is a blank menu page
  16.    (while (/= readno (+ scrlen 3))  (grtext)                 ;The menu loop
  17.       (grtext (+ scrlen 1) "PREVIOUS")
  18.       (grtext (+ scrlen 2) "NEXT")
  19.       (grtext (+ scrlen 3) "EXIT")
  20.       (grtext (+ scrlen 5) "INSERT")
  21.       (grtext (+ scrlen 7) (if flage "Exit Off"  "Exit On"))
  22.       (grtext (+ scrlen 8) (if flagsv "Sav L ON" "SavL OFF"))
  23.       (prompt "SELECT BLOCK/DWG TO VIEW SLIDE\n")
  24.       (dspfls fls scrlen pathln pageno)              ;display file list
  25.       (grtext -1 (strcat (substr (car fls) 1 (1- pathln))
  26.       " " (if fl (substr fl pathln) "")))
  27.       (grtext -2 (strcat "Page No. " (itoa pageno)))
  28.       (setq readno (nth 1 (grread)))                       ;stop here
  29.       (cond                                 ;which line number does readno contain
  30.          ((and (>= readno 0) (< readno scrlen)(not (listp readno))) ;in the file list
  31.             (if (setq fl (nth (+ readno (* pageno scrlen)) fls))
  32.                (if (findfile (strcat fl ".SLD")) (command "VSLIDE" fl)
  33.          (progn (grclear) (prompt (strcat " No Slide found for " fl "\n"))))))
  34.  
  35.          ((= readno (+ scrlen 1)) (prevpg))              ;"Previous" page
  36.          ((= readno (+ scrlen 2)) (nextpg))              ;"Next" page
  37.  
  38.          ((= readno (+ scrlen 5)) (if fl                   ;"Insert" option
  39.                (if (findfile (strcat fl ".DWG"))
  40.                   (if (not flage) (progn  (command "INSERT" fl ) (setq readno (+ scrlen 3))) 
  41.                   (command "REDRAW" "INSERT" fl pause pause pause pause))
  42.          (prompt (strcat " NO DRAWING FOUND FOR " fl "\n"))))) 
  43.  
  44.          ((= readno (+ scrlen 7))                       ;"Exit On" "Exit Off" toggle
  45.          (if flage (setq flage nil)(setq flage T))) ;flage = flag_exit
  46.  
  47.          ((= readno (+ scrlen 8))                        ;"Save List On/Off"
  48.          (if flagsv (setq flagsv nil)(setq flagsv T)))  ;flagsv = flag_save_vsldlist
  49.    ))  ;cond and while
  50.    (if (not flagsv) (setq fls nil))
  51. (grtext) (menucmd "S=S")(redraw)) ;exit to your menu screen, end function VSLD
  52. ;*****************************************************************************
  53. ;Slash operator subroutine - changes menu foreslash to dos backslash (fix)
  54. ;pslash is from "Inside Autolisp", Smith & Gesner,-"gratefully acknowledged"
  55. (defun pslash (path / inc slash wpath char)
  56.    (setq inc 1  wpath ""  slash "\\")
  57.    (while (/= "" (setq char (substr path inc 1)))
  58.       (setq wpath (strcat wpath (if (member char '("\\" "/")) slash char))
  59.    inc (1+ inc)))
  60.    (if (and (/= wpath "") (/= (substr wpath (strlen wpath) 1) slash))
  61.    (setq wpath (strcat wpath slash)))
  62. wpath) 
  63.  
  64. ;Subr getdwg is a derivative of GETFIL from "Inside Autolisp" Smith & Gesner
  65. (defun getdwg (path  / fls fl fil)
  66.    (setq fil (open "dir.$" "w")) (close fil)
  67.    (setq fl (strcat path "*.dwg" ))
  68.    (command "SH" (strcat "for %f in (" fl ") do echo %f >> " "dir.$"))
  69.    (command "SH"  "SORT < dir.$ > tmp.$")
  70.    (command "SH"  "copy tmp.$ dir.$")
  71.    (command "SH" "del tmp.$")
  72.    (if (setq fil (open "dir.$" "r")) (progn
  73.          (if (setq fl (read-line fil)) 
  74.             (while (and fl (/= "" fl))            ;the read-line loop
  75.                (setq fls (append fls (list (substr fl 1 (- (strlen fl) 5)))))
  76.          (setq fl (read-line fil))))   ; while if
  77.       (close fil) (command "SH" "del dir.$")) ;progn
  78.    (prompt "\nFile could not be opened ")) ;if
  79. (if fls fls (prompt "\nNo files found ")))
  80.  
  81. ;Number of Screen Pages subroutine
  82. (defun pag#s (fls scrlen / pages)
  83.    (setq pages (/ (length fls) scrlen))
  84.    (if (and (= 0 (rem (length fls) scrlen))(>= pages 1))(setq pages (1- pages)))
  85. pages)    ;returns
  86.  
  87. ;Display Files to Screen subroutine
  88. (defun dspfls (fls scrlen pathln pageno / inc)
  89.    (setq inc 0)
  90.    (repeat scrlen (if (> (length fls) (+ inc (* pageno scrlen)))   
  91.       (grtext inc (substr (nth (+ inc (* pageno scrlen)) fls) pathln)))
  92. (setq inc (1+ inc))))
  93.  
  94. (defun prevpg ()   ;Subr previous page
  95. (if (/= pageno 0) (setq pageno (1- pageno)) (setq pageno pages)))
  96. (defun nextpg ()   ;Subr next page
  97. (if (/= pageno pages) (setq pageno (1+ pageno)) (setq pageno 0)))
  98.  
  99. ;Subr to get directory and present default. Create **DIRS in your menu to pick
  100. ;your block directories. Set up your own primary default. Empty string default
  101. ; "" not recommended because findfile will search all Set acad= directories
  102. (defun getdir (tmpdir / tmp)                      
  103.    (if (= tmpdir nil) (setq tmpdir "c:\\acad\\")) ;primary default
  104.    (menucmd "s=blank") (menucmd "s=dirs")         ;**DIRS  [Label]C:/Label
  105.    (if (and (setq tmp (getstring (strcat "\nPATH< " tmpdir " >: ")))
  106.    (/= tmp ""))   (setq tmpdir (pslash tmp)))
  107. (menucmd "s=blank") tmpdir)
  108.  
  109. ;Subr to get directory string length - Get length of file name, start at end
  110. (defun dirlen (fl / slash inc)           ; and count backwards to last slash.
  111.    (setq inc (strlen fl) slash "\\")       ; (dirlen "1234\678") returns 6
  112.    (while (and (/= inc 0) (/= slash (substr fl inc 1)))(setq inc (1- inc)))
  113. (setq inc (1+ inc)) inc)                ;(substr "1234\678" 6) returns "678"
  114. ;end vsld1.lsp
  115.