home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / TR2PL.LSP < prev    next >
Lisp/Scheme  |  1989-09-06  |  4KB  |  75 lines
  1. ;tr2pl.lsp - by c.l.smith, stardot lsp, houston, tx.
  2. ;routine to replace traces with plines. you can convert all layers, or only
  3. ;one at a time, keeping the original trace widths or replacing all with fixed
  4. ;width of your choice.
  5. ;global variables:  ndx = holds tentative position in selection set
  6. ;                   ss = selection set of traces to be processed
  7. ;note that some undocumented acad variables are used in this routine.
  8.  
  9. (defun aval (a l / )      ;returns value from association list
  10.   (cdr (assoc a l)))
  11.  
  12. (defun convrt ( / pl1 pl2 clist)      ;the meat of it
  13.   (setq pl1 (entget (ssname ss ndx))  ;get first segment
  14.         pl2 (if (> ndx 0) (entget (ssname ss (- ndx 1))) nil) ;get next segment
  15.         ndx (- ndx 1))                ;increment the index
  16.   (command "layer" "s" (aval 8 pl1) "")     ;set layer (redundant for 1 layer)
  17.   (setq clist                               ;start command list to draw
  18.         (list "pline"                       ;a pline from 1st point
  19.               (midpnt (aval 10 pl1) (aval 11 pl1))
  20.               "w"                           ;set the width
  21.               (if fixwid fixwid (distance (aval 10 pl1) (aval 11 pl1)))
  22.               ""                            ;no tapered pee lines, ok?
  23.               (midpnt (aval 12 pl1) (aval 13 pl1))))    ;to 2nd point
  24.   (while (and pl2 (apply 'and         ;check next segment for continuation. if
  25.               (mapcar 'equal          ;ends are equal then add next point to
  26.                     (list (aval 12 pl1) (aval 13 pl1))     ;command list and
  27.                     (list (aval 10 pl2) (aval 11 pl2)))))  ;test next segment
  28.         (write-line "Match found!")                       ;oterwise exit & draw
  29.         (setq clist (append clist (list (midpnt (aval 12 pl2) (aval 13 pl2))))
  30.               pl1 pl2
  31.               pl2 (if (> ndx 0) (entget (ssname ss (- ndx 1))) nil)
  32.               ndx (- ndx 1)))
  33.   (setq clist (append clist '("")))
  34.   (apply 'command clist))
  35.  
  36. (defun delall (s / len n) ;passed a selection set, entity-deletes it
  37.   (setq len (sslength s)
  38.         n 0)
  39.   (while (< n len)
  40.         (entdel (ssname s n))
  41.         (setq n (+ 1 n))))
  42.  
  43. (defun getall ( e l / )   ;returns selection set of all entities of type "e"
  44.   (ssget "x"              ;on the layer "l"
  45.         (if (= l "*") (list (cons 0 (strcase e)))
  46.               (list (cons 0 (strcase e)) (cons 8 l)))))
  47.  
  48. (defun midpnt (p1 p2 / )  ;returns midpoint between p1 and p2
  49.   (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
  50.  
  51. (defun c:tr2pl ( / savars layr )            ;traces to plines command
  52.   (setvar "useri1" (getvar "highlight"))    ;store variables
  53.   (setvar "useri2" (getvar "blipmode"))
  54.   (setvar "highlight" 0)                    ;adjust as desired
  55.   (setvar "blipmode" 0)
  56.   (setq layr "doodah")
  57.   (setq layr (getstring "\nLayer name to convert, * for all: "))
  58.   (initget 1 "Y N")
  59.   (setq fixwid
  60.         (if (= (getkword "\nUse original width (Y/N)? ") "N")
  61.               (getreal "Width for all plines: ") nil)
  62.         ss (getall "trace" layr))
  63.   (if ss (progn
  64.               (setq ndx (- (sslength ss) 1))
  65.               (write-line (strcat (itoa (sslength ss)) " traces to process."))
  66.               (while (>= ndx 0)
  67.                     (write-line (strcat "Processing " (itoa ndx)))
  68.                     (convrt))
  69.               (delall ss)
  70.               (redraw))
  71.         (prompt "Couldn't find a trace"))
  72.   (setvar "highlight" (getvar "userr1" ))
  73.   (setvar "blipmode" (getvar "userr2" ))
  74.   'done (princ))
  75.