Lisp Fillet autocad 2012 va 2013

;;; MY-FILLET.LSP Fillet PolyLines
;;; Fillets Any Type of Line (Line, PolyLine, LWPolyLine or Spline)
;;; by Ibro Vehabovic, March 1999.
;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Join-then-fillet-polylines/td-p/.UNyL7-SLlyI

(defun c:my-fillet (/ getval spl2pl e1 e2 p2 l e ss)

;;; GETVAL - returns the group value of an entity.
;;; like the wellknown (dxf) function but accepts all kinds of
;;; entity representations (ename, entget list, entsel list)
  (defun GETVAL   (grp ele)      ;"dxf value" of any ent...
    (cond ((= (type ele) 'ENAME)   ;ENAME
     (cdr (assoc grp (entget ele)))
     )
     ((not ele) nil)      ;empty value
     ((not (listp ele)) nil)   ;invalid ele
     ((= (type (car ele)) 'ENAME)   ;entsel-list
     (cdr (assoc grp (entget (car ele))))
     )
     (T (cdr (assoc grp ele)))
    )
  )               ;entget-list

;;; "converts" SPLINE to PLINE
  (defun spl2pl   (ent / osm pdm deltaL pn pts e)
    (setq osm (getvar "OSMODE"))
    (setq pdm (getvar "PDMODE"))
    (setvar "OSMODE" 0)
    (setvar "PDMODE" 0)
    (setq
      deltaL (*   (/ (GETVAR "viewsize") (CADR (GETVAR "screensize")))
      (getvar "pickbox")
      2.0
       )
    )               ; max segment=2 * size of
    pickbox
    (if   (= (getval 0 ent) "POLYLINE")   ; heavy pline
      (progn
   (setq e ent)
   (while (= (getval 0 (setq e (entnext e))) "VERTEX")
     (setq pts (cons (getval 10 e) pts))
   )
   (setq pn  (car pts)
         pts (list (last pts))
   )
      )
      (setq pts   (list (getval 10 ent))   ; start pt
       pn   (getval 10 (reverse (entget ent)))
      )
    )               ; end pt
    (command ".POINT" pn)
    (setq e (entlast))
    (entdel e)
    (command ".AREA" "_O" ent)
    (command ".DIVIDE"
       ent
       (fix (/ (getvar "perimeter") deltaL))
    )
    (while (setq e (entnext e))
      (setq pts (cons (getval 10 e) pts))
      (entdel e)
    )
    (setq pts (reverse (cons pn pts)))
    (apply 'command (append '(".PLINE") pts '("")))
    (command ".CHANGE"
       (entlast)
       ""
       "_P"
       "_LA"
       (getval 8 ent)
       ""
    )
    (if   (getval 62 ent)
      (command ".CHANGE"
         (entlast)
         ""
         "_P"
         "_C"
         (getval 62 ent)
         ""
      )
    )
    (entdel ent)
    (setvar "PDMODE" pdm)
    (setvar "OSMODE" osm)
    (entlast)
  )               ;defun spl2pl

  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (while (null (setq e1 (entsel "nSelect first object: "))))
  (if (= (getval 0 e1) "SPLINE")
    (setq e1 (list (spl2pl (car e1)) (cadr e1)))
  )
  (if (= (getval 0 e1) "POLYLINE")
    (if   (> (getval 70 e1) 1)
      (setq e1 (list (spl2pl (car e1)) (cadr e1))) ;fit or spline
      (command ".CONVERTPOLY" "_L" (car e1) "")
    )
  )               ;heavy pline
  (redraw (car e1) 3)
  (while (null (setq e2 (entsel "nSelect second object: "))))
  (if (= (getval 0 e2) "SPLINE")
    (setq e2 (list (spl2pl (car e2)) (cadr e2)))
  )
  (if (= (getval 0 e2) "POLYLINE")
    (if   (> (getval 70 e2) 1)
      (setq e2 (list (spl2pl (car e2)) (cadr e2))) ;fit or spline
      (command ".CONVERTPOLY" "_L" (car e2) "")
    )
  )               ;heavy pline
  (redraw (car e2) 3)
  (setq p2 (cadr e2))
  (setq e2 (car e2))
  (if (and (= (getval 0 e1) "LWPOLYLINE")
     (= (getval 0 e2) "LWPOLYLINE")
      )
    (progn
      (setq l (entlast))
      (command ".EXPLODE" e2)
      (setq ss (ssadd))
      (ssadd (setq e (entnext l)) ss)
      (while (setq e (entnext e))
   (ssadd e ss)
      )
      (command ".FILLET" e1 (nentselp p2))
      (command ".PEDIT" e1 "_J" ss "" "") ; join
      (command ".ERASE" ss "")      ; erase unjoined segments
               ; of the second polyline
    )               ;progn
    (command ".FILLET" e1 (nentselp p2)) ;normal fillet
  )               ;if
  (command "._UNDO" "_E")
  (princ)
)               ;defun