;|  
  C:FILLETPL  Fillets two parallel lines with single line.
              Selection and resultant fillet follows normal
              FILLET 0 convention.

Routine compatible with R12-2000.

	AutoLISP Files for Maximizing AutoCAD
	Permission to use copy or modify this
	program is hereby granted, and is supplied
	on an "as is" basis.
  
Developed by SYD Derbyshire - june '96

------------------------------------------------------------------------
------------------------------------------------------------------------
 Modified by J. Tippit, SPAUG President
    E-mail:                     jefft@iglobal.net
    Web Site:                http://www.spaug.org
------------------------------------------------------------------------
------------------------------------------------------------------------

Revisions:
1.0	Originally created				06/96
1.1	Added UCS and UNDO support			04/12/99
1.2	Added error checking				04/26/99
1.3	Added R12 Undo support				05/05/99
1.4	Added entity unhighlight if cancel		05/10/99

|;

(defun err (s)
   (if (not (member s '("console break" "Function cancelled")))
      (princ (strcat "\nError: " s "\nResetting Variables."))
   )
   (if l1 (redraw (car l1) 4))
   (setvar "OSMODE" osmd)
   (command "_ucs" "_P")
   (command "_undo" "_e")
   (setvar "cmdecho" 1)
   (setq *error* olderr)
   (princ)
) 

(defun C:FILLETPL (/ osmd aname bname elay elt eclr
                     l1 l2 a b ang_a newang pt1 pt2 pt3 ptint enl)
   (setq olderr *error* *error* err)
   (setvar "CMDECHO" 0)
   (if (wcmatch (getvar "ACADVER") "*12*")
      (command "_undo" "_g")
      (command "_undo" "_be")
   )
   (command "_ucs" "")
   (setvar "FILLETRAD" 0)
   (setq osmd (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   (setq dwgsc (getvar "DIMSCALE"))
   (while (not (= aname "LINE"))
      (setq l1 (entsel "\nSelect first line: "))
      (setq pt1 (osnap (cadr l1) "endp"))
      (redraw (car l1) 3)
      (setq a (entget (car l1)))
      (setq aname (cdr (assoc 0 a)))
      (if (not (= aname "LINE"))
         (progn
            (prompt "\nEntity is not a line. ")
            (redraw (car l1) 4)
         )
      )
   )
   (while (not (= bname "LINE"))
      (setq l2 (entsel "\nSelect second line: "))
      (setq b (entget (car l2)))
      (setq bname (cdr (assoc 0 b)))
      (if (not (= bname "LINE"))(prompt "\nEntity is not a line. "))
   )
   (setq elay (cdr (assoc 8 a)))
   (setq elt (cdr (assoc 6 a)))
   (setq eclr (cdr (assoc 62 a)))
   (if (null elt)(setq elt "BYLAYER"))
   (if (null eclr)(setq eclr "BYLAYER"))
   (if (= eclr 0)(setq eclr "BYBLOCK"))
   (redraw (car l1) 4)
   (setq end10_a (cdr (assoc 10 a)))
   (setq end11_a (cdr (assoc 11 a)))
   (setq end10_b (cdr (assoc 10 b)))
   (setq end11_b (cdr (assoc 11 b)))
   (setq ang_a (angle end10_a end11_a))
   (setq newang (- ang_a (/ pi 2)))
   (setq pt3 (polar pt1 newang dwgsc))
   (setq ptint (inters pt1 pt3 end10_b end11_b nil))
   (command "_LINE" pt1 ptint "")
   (setq enl (entlast))
   (command "_CHPROP" enl "" "_LA" elay "_C" eclr "_LT" elt "")
   (command "_fillet" enl l2)
   (setvar "OSMODE" osmd)
   (command "_ucs" "_P")
   (command "_undo" "_e")
   (setvar "cmdecho" 1)
   (setq *error* olderr)
   (princ)
)
(prompt "\nType FILLETPL to run.\tVersion 1.4 - Fillet Parallel routine ")
(princ)