;|===========================================================================|;
;| : Multiple Fillet                                                      |;
;|   Seçilen obje gurubu içinde iki ayrı doğrultuda, kendi içinde biribirine |;
;|   paralel doğruları yerleşim sıralarına uygun olarak Fillet eder.         |;
;|          Author: M. Şahin Güvercin - www.autocadokulu.com - 01.06.2012    |;
;|---------------------------------------------------------------------------|;
(defun c:FFG (/ AnG AnS Ds1 Ds2 DsT eP ePT iNp ipT Ln1 Ln2 LnS m myerr n o obJ
              oFr olderr oRa orT p1 p2 p3 PnT Pv1 Pv2 PvP PvT Rad RdS rTp sP
              SpT sR1 sR2 tLr ucL)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun myerr (errmsg)
    (if (/= errmsg "Function cancelled") (prompt errmsg))
    (command "._undo" "_e") (command "._U") (setvar "FiLLetRad" oFr)
    (setq *error* olderr) (princ))
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (setq tLr 1.0E-08  sP 'StartPoint eP 'EndPoint oFr (getvar "FiLLetRad")
        oRa (if oRa oRa 0.0) Rad oRa orT (if orT orT "Fixed") rTp orT)
  (princ "\nSelect Lines to be Fillet [Enter: Specify Radius and Type]: ")
  (while (not (setq ObJ (ssget (list (cons 0 "Line")))))
    (setq Rad (getdist (strcat "\nSpecify Minimum Fillet Radius <"
                         (rtos oRa) ">: "))) (if (not Rad) (setq Rad oRa))
    (if (zerop Rad) (setq rTp "Fixed")
      (setq RtP (initget "Fixed Parallel")
            rTp (getkword(strcat "\nRadius Type <"orT">: [Fixed/Parallel]: "))
            rTp (if rTp rTp orT)))) (setq oRa Rad orT rTp n (sslength ObJ))
  (while (>= (setq n (1- n)) 0)
    (setq AnG (vlax-get-property(vlax-ename->vla-object(ssname ObJ n))'AngLe)
          AnG (if(>= AnG pi)(- AnG pi)AnG) AnG (atof (rtos AnG 2 8))
          Ans (append (list AnG) (vl-remove AnG Ans))))
  (while (< (setq n (1+ n)) (sslength ObJ))
    (setq PvT (vlax-ename->vla-object (ssname ObJ n))
          AnG (vlax-get-property PvT'AngLe) AnG (if(>= AnG pi)(- AnG pi) AnG))
    (if (equal Ang (nth 0 Ans) tLr) (setq Ln1 (append Ln1 (list PvT)))
      (if (equal AnG (nth 1 Ans) tLr) (setq Ln2 (append Ln2 (list PvT))))))
  (if(<(Length Ln1)(length Ln2))(setq LnS(length Ln1))(setq Lns(length Ln2)))
  (setq n -1 o 0)
  (while (< (setq m -1 n (1+ n)) Lns)
    (while (< (setq m (1+ m)) Lns)
      (setq iPt (append iPt (list (vlax-safearray->list (vlax-variant-value
                (vla-intersectwith(nth n Ln1)(nth m Ln2)AcExtendBoth))))))))
  (while (<= (setq n -1 o (1+ o)) 2)
    (while (< (setq  DsT nil PnT nil ucL nil m -1 n (1+ n)) Lns)
      (setq PvT (nth n (eval (read (strcat "Ln" (itoa o)))))
       SpT(vlax-safearray->list(vlax-variant-value(vlax-get-property PvT sP)))
       EpT(vlax-safearray->list(vlax-variant-value(vlax-get-property PvT eP))))
      (while (< (setq m (1+ m)) (length iPt)) (setq iNp (nth m iPt))
        (if(equal(distance iNp(vlax-curve-getClosestPointTo PvT iNp T))0.0 tLr)
          (if (< (distance (vlax-curve-getClosestPointTo PvT iNp) SpT)
                 (distance (vlax-curve-getClosestPointTo PvT iNp) EpT))
            (if (not DsT) (setq PnT iNp ucL 'StartPoint Dst (distance PnT EpT))
   (if(<(distance iNp EpT)DsT)(setq PnT iNp ucL sP DsT(distance PnT EpT))))
           (if (not DsT) (setq PnT iNp ucL eP Dst (distance PnT SpT))
   (if(<(distance iNp SpT)DsT)(setq PnT iNp ucL eP DsT(distance PnT SpT)))))))
     (vlax-put-property PvT ucL (vlax-3d-point PnT)))) (setq n -1)
(while (< (setq m -1 n (1+ n)) LnS)
   (while (< (setq m (1+ m)) LnS)
     (if (not (minusp (vlax-safearray-get-u-bound (setq o (vlax-variant-value
               (vla-intersectwith (nth n Ln1) (nth m Ln2) AcExtendNone))) 1)))
       (setq Pv1 (nth n Ln1) Pv2 (nth m Ln2) PvP (vlax-safearray->list o)))))
(setq m 0)
  (while (<= (setq n -1 m (1+ m)) 2)
    (while (< (setq n (1+ n)) LnS)
      (set(read(strcat"Ds"(itoa m)))(append(eval(read(strcat"Ds"(itoa m))))
               (list(distance PvP(vlax-curve-getclosestPointTo
                            (nth n(eval(read(strcat"Ln"(itoa m)))))PvP T)))))))
  (setq sR1 (vl-sort-i Ds1 '<) sR2 (vl-sort-i Ds2 '<)
        Ds1 (vl-sort Ds1 '<) Ds2 (vl-sort Ds2 '<) n -1)
  (while (< (setq n (1+ n)) LnS)
    (if (zerop Rad) (setq RdS (append RdS (list 0)))
      (if (= rTp "Fixed") (setq RdS (append RdS (list Rad)))
        (if (< (nth n Ds1) (nth n Ds2))
          (setq RdS (append RdS (list (+ Rad (nth n Ds1)))))
          (setq RdS (append RdS (list (+ Rad (nth n Ds2)))))))))
  (mapcar '(lambda (p1 p2 p3) (setvar "FiLLetRad" p1)
             (vl-cmdf "FiLLet" (vlax-vla-object->ename (nth p2 Ln1))
                      (vlax-vla-object->ename (nth p3 Ln2)))) RdS sR1 sR2)
  (setvar "FiLLetRad" oFr) (command "_.undo" "end") (setq *error* olderr)
  (*pop-error-mode*) (setvar "cmdecho" 1)(prin1))