home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / mar94cad.zip / TIP965.LSP < prev    next >
Lisp/Scheme  |  1994-02-15  |  4KB  |  104 lines
  1. ; TIP965.LSP: REPLRD.LSP   Parallel Lines from Plines  (c)1994, Bill Bratt
  2.  
  3. (defun C:REPLRD ()
  4.    (setvar "cmdecho" 0)
  5.    (setq WIDTH 0.0
  6.       ANG   nil
  7.       IPS   (getreal "\n Road Width Edge to Edge: ")
  8.       LYR   (strcase (getstring "\n NEW Road Edge Layer: "))
  9.       LYR2   (strcase (getstring "\n EXISTING Road Centerline Layer: "))
  10.    )
  11.  
  12.    ;   (command ".rename" "la" LYR LYR2)
  13.    (command ".layer" "m" LYR2 "m" LYR "")
  14.    (command)
  15.    ;---
  16.    (setq Ent (Entnext))
  17.    (while Ent
  18.       (setq ental (entget Ent))
  19.       (if (eq LYR2 (CDR (Assoc 8 ental)))
  20.          (progn
  21.             (if (eq "POLYLINE" (cdr (assoc 0 ental)))
  22.                (progn
  23.                   ;               (SetQ ental (subst (cons 8 lyr) (assoc 8 ental) ental))
  24.                   (SetQ ental (subst (cons 40 width) (assoc 40 ental) ental))
  25.                   (SetQ ental (subst (cons 41 width) (assoc 41 ental) ental))
  26.                   (entmod ental)
  27.                )
  28.             )
  29.             (setq Ent (entnext Ent))
  30.          ) ;end progn
  31.          (setq Ent (entnext Ent))
  32.       ) ;end if
  33.    ) ;end while
  34.    ;---
  35.    (setq Ent (Entnext))
  36.    (while Ent
  37.       (setq ental (entget Ent))                     ;POLYLINE
  38.       (if (and (eq LYR2 (CDR (Assoc 8 ental)))
  39.             (eq "POLYLINE" (cdr (assoc 0 ental)))
  40.          )
  41.          (progn
  42.             (setq ent   (entnext ent)               ;VERTEX1
  43.                ental (entget ent)
  44.                p1    (cdr (assoc 10 ental))
  45.                pts2  nil
  46.                pts3  nil
  47.                ent   (entnext ent)               ;VERTEX2
  48.                ental (entget ent)
  49.                p2   (cdr (assoc 10 ental))
  50.                ang  (angle p1 p2)
  51.                ang1 (+ (/ pi 2.0) ang)
  52.                ang2 (+ (* pi 1.5) ang)
  53.                p3   (polar p1 ang1 (/ ips 2.0))
  54.                p4   (polar p1 ang2 (/ ips 2.0))
  55.                p5   (polar p2 ang1 (/ ips 2.0))
  56.                p6   (polar p2 ang2 (/ ips 2.0))
  57.                pts2 (cons p3 pts2)               ;1st list of points
  58.                pts3 (cons p4 pts3)               ;2nd list of points
  59.                p1   p2
  60.                ent   (entnext ent)               ;VERTEX3
  61.                ental (entget ent)
  62.             )
  63.             (while (eq "VERTEX" (cdr (assoc 0 ental)))
  64.                (setq p2   (cdr (assoc 10 ental))
  65.                   ang3 (angle p1 p2)
  66.                   ang4 (+ (/ pi 2.0) ang3)
  67.                   ang5 (+ (* pi 1.5) ang3)
  68.                   p8   (polar p1 ang4 (/ ips 2.0))
  69.                   p9   (polar p1 ang5 (/ ips 2.0))
  70.                   p10  (polar p2 ang4 (/ ips 2.0))
  71.                   p11  (polar p2 ang5 (/ ips 2.0))
  72.                   p12  (inters p3 p5 p8 p10 nil)
  73.                   p13  (inters p4 p6 p9 p11 nil)
  74.                )
  75.                (if (eq p12 nil) (setq p12 p5))
  76.                (if (eq p13 nil) (setq p13 p6))
  77.                (setq pts2 (cons p12 pts2)
  78.                   pts3 (cons p13 pts3)
  79.                   p1   p2
  80.                   p3   p8
  81.                   p4   p9
  82.                   p5   p10
  83.                   p6   p11
  84.                   ent   (entnext ent)
  85.                   ental (entget ent)
  86.                )
  87.             ) ;end while
  88.             (setq pts2 (cons p5 pts2)
  89.                pts3 (cons p6 pts3)
  90.                Ent (entnext Ent)
  91.             )
  92.             (apply 'command (cons ".pline" (reverse pts2)))
  93.             (command)
  94.             (apply 'command (cons ".pline" (reverse pts3)))
  95.             (command)
  96.          ) ;end progn
  97.          (setq Ent (entnext Ent))
  98.       ) ;end if
  99.    ) ;end while
  100.    (princ)
  101.    ;(command ".layer" "f" LYR2 "")
  102.    ;(command ".resume")
  103. ) ;end replrd.lsp
  104.