home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / ERWIN.LSP < prev    next >
Encoding:
Text File  |  1992-01-30  |  4.3 KB  |  113 lines
  1. (defun erwinerr(s)
  2.   (if (/= s "Function cancelled")
  3.       (princ (strcat "\nError:" s))
  4.   )
  5.   (setvar "osmode" 0)
  6.   (setvar "aperture" 3)
  7.   (setvar "pickbox" 3)
  8.   (command "layer" "s" "0" "")
  9.   (setvar "cmdecho" 1)
  10.   (setq *error* oer)
  11.   (princ)
  12. )
  13.  
  14. (defun c:erwin(/ oer ss ssl n sn en ename elay bn ip sx sy wl ww rp lp att cen ss1 en1 lw col elay1)
  15.   (setvar "cmdecho" 0)
  16.   (setq oer *error* *error* erwinerr)
  17.   (setq ss (ssget))
  18.   (if ss (progn
  19.    (setq ssl (sslength ss) n 0)
  20.    (repeat ssl
  21.      (setq sn (ssname ss n) en (entget sn))
  22.      (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  23.      (setq bn (cdr (assoc 2 en)))
  24.      (cond ((and (= ename "INSERT") (= elay "PWINDOW") (= (strcase (substr bn 1 2)) "MM"))
  25.      (setq ip (cdr (assoc 10 en)) sx (cdr (assoc 41 en)))
  26.      (setq sy (cdr (assoc 42 en)) ang (cdr (assoc 50 en)))
  27.      (setq wl (abs (* sx 100.0)) ww (abs (* sy 10.0)))
  28.      (setq rp (polar ip (+ ang pi) (/ wl 2.0)))
  29.      (setq lp (polar ip ang (/ wl 2.0)))
  30.      (erpoly lp rp)
  31.      ) ;cond1
  32.      ((and (= ename "INSERT") (= elay "PWINDOW") (= (substr bn 1 4) "CCAM"))
  33.      (setq att (cdr (assoc 1 (entget (entnext (entnext sn))))))
  34.      (strdv att)
  35.      (setq lp (list (atof (nth 0 wlist)) (atof (nth 1 wlist)) 0.0))
  36.      (setq cen (list (atof (nth 2 wlist)) (atof (nth 3 wlist)) 0.0))
  37.      (setq rp (list (atof (nth 4 wlist)) (atof (nth 5 wlist)) 0.0))
  38.      (setq ss1 (ssget (osnap rp "END")))
  39.      (command "erase" sn "")
  40.      (if (setq en1 (entget (ssname ss1 0))) (progn
  41.      (setq lw (cdr (assoc 40 en1)))
  42.      (setq col (cdr (assoc 62 en1)) elay1 (cdr (assoc 8 en1)))
  43.      (if col (command "color" col))
  44.      (command "layer" "s" elay1 "")
  45.      (command "pline" lp "w" lw lw "a" "ce" cen rp "")
  46.      (command "color" "bylayer")))
  47.      (command "layer" "s" "0" "")
  48.      ) ;cond2
  49.      ((and (= ename "INSERT") (= elay "PWINDOW") (= (strcase (substr bn 1 2)) "CC"))
  50.      (command "erase" sn ""))
  51.      ) ;end cond
  52.      (setq n (1+ n))
  53.      )
  54.      )) ;endif ss
  55.      (setq *error* oer)
  56.      (setvar "cmdecho" 1)
  57.      (princ)
  58. )
  59.  
  60. (defun erpoly(lp rp / ss1 ss2 sn1 sn2 en1 en2 enm1 enm2 elay1 elay2 pl sn1 sn2 sn11 sn22 lw col nn n0)
  61.      (command "erase" sn "")
  62.      (setq ss1 (ssget (osnap rp "END")) ss2 (ssget (osnap lp "END")))
  63.      (if (and (setq sn1 (ssname ss1 0)) (setq sn2 (ssname ss2 0)))
  64.      (progn
  65.      (setq en1 (entget sn1) en2 (entget sn2) pl nil)
  66.      (setq enm1 (cdr (assoc 0 en1)) enm2 (cdr (assoc 0 en2)))
  67.      (setq elay1 (cdr (assoc 8 en1)) elay2 (cdr (assoc 8 en2)))
  68.      (if (and (= "POLYLINE" enm1) (= "PWALL" (substr elay1 1 5)) (= "POLYLINE" enm2) (= "PWALL" (substr elay2 1 5)))
  69.      (progn
  70.      (setq sn11 sn1 sn22 sn2 lw (cdr (assoc 40 en1)) col (cdr (assoc 62 en1)))
  71.      (while (/= (cdr (assoc 0 (entget (setq sn1 (entnext sn1))))) "SEQEND") 
  72.      (setq pl (cons (list (cdr (assoc 10 (entget sn1))) (cdr (assoc 42 (entget sn1)))) pl))
  73.      )
  74.      (setq pl (cdr pl) nn 0)
  75.      (while (/= (cdr (assoc 0 (entget (setq sn2 (entnext sn2))))) "SEQEND")
  76.      (if (> nn 0)(setq pl (cons (list (cdr (assoc 10 (entget sn2))) (cdr (assoc 42 (entget sn2)))) pl)))
  77.      (setq nn (1+ nn))
  78.      )
  79.      (command "erase" sn11 sn22 "")
  80.      (setq pl (reverse pl))
  81.      (if (/= col nil)
  82.      (entmake (list (cons 0 "POLYLINE") (cons 8 elay1) (cons 62 col) (cons 66 1) (cons 40 lw) (cons 41 lw)))
  83.      (entmake (list (cons 0 "POLYLINE") (cons 8 elay1) (cons 66 1)(cons 40 lw) (cons 41 lw))))
  84.      (setq n0 0)
  85.      (repeat (length pl)
  86.         (entmake (list (cons 0 "VERTEX") (cons 42 (cadr (nth n0 pl)))(append (list 10) (car (nth n0 pl)))))
  87.         (setq n0 (1+ n0))
  88.      )
  89.      (entmake (list (cons 0 "SEQEND")))
  90.      ) ;endprogn
  91.      (command "u")
  92.      )
  93.      ) ;endprogn
  94.      (command "u")
  95.      )
  96. )
  97.  
  98. (defun strdv(rn / loop l x)
  99.        (setq wlist nil loop t)
  100.        (while loop
  101.           (setq l (instr 1 rn " "))
  102.           (if (= l 0) (setq wlist (cons rn wlist) loop nil)
  103.              (progn ;else
  104.              (setq x (substr rn 1 (1- l)))
  105.              (setq wlist (cons x wlist))
  106.              (setq rn (substr rn (1+ l) (- (strlen rn) l)))
  107.              (setq loop t)
  108.              )
  109.           )
  110.        )
  111.        (setq wlist (reverse wlist))
  112. )
  113.