Fillet Polylines with no Trim

[Ahmed Khaled]

Hi all;

I found this lisp below on the internet it works perfectly, but i have multiple lines i need to enter the radius for each line, so i was wondering if anyone can help me to let the lisp take the same fillet as regular fillet without asking each time and the lisp repeat it self untill pressing "ESC", Thanks in advance 

 

; fillet with Radius, First keep, second trim

(defun c:FCLL (/ *error* adoc oVAR nVAR getval e1 e2 entq p2 l l1 e er ss 1pt 2pt midpt ename param oblouk LayerName z1)
  
  ;********
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (mapcar 'setvar nVAR oVAR)
    (vla-endundomark adoc)
    (princ))
  
  
  ;;; 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))))
    ); end getval
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq oVAR (mapcar 'getvar (setq nVAR '(CMDECHO TRIMMODE PEDITACCEPT OSMODE))))
  (mapcar 'setvar nVAR             '(1      0       1           0     ))
  
  (setvar "filletrad" (cond ((getreal (strcat "\nSpecify fillet radius <" (rtos (getvar "filletrad") 2 2) ">: ")))
                (T (getvar "filletrad"))))
  
  (while (and (null (setq e1 (entsel "\nSelect first object (TO BE MODIFIED): ")))
          (wcmatch (getval 0 e1) "LINE,ARC,LWPOLYLINE")))
  
  ;Identify the layer of the first selected entity
  (setq LayerName (cdr (assoc 8 (entget (car e1)))))
  
  (redraw (car e1) 3)
  
  (while (and (null (setq e2 (entsel "\nSelect second object (REMAINS THE SAME): ")))
          (wcmatch (getval 0 e2) "LINE,ARC,LWPOLYLINE")))
  (redraw (car e2) 3)
  
  (setq p1 (cadr e1))
  (setq e1 (car e1))
  
  
  (if (= (getval 0 e1) "LWPOLYLINE")                    ;if 1nd polyline
    (progn
      (setq l (entlast))
      (command "_.EXPLODE" e1)                        ;make it line or arc (would be trimed)
      (setq ss (ssadd))
      (ssadd (setq e (entnext l)) ss)
      (while (setq e (entnext e))
    (ssadd e ss))))
  (if (= (getval 0 e2) "LWPOLYLINE")                     ;if 2st polyline
    (progn
      (setq ename (car e2)
        midpt (vlax-curve-getClosestPointTo ename (trans (cadr e2) 1 0))
        param (vlax-curve-getParamAtPoint ename midpt)
        1pt (vlax-curve-getPointAtParam ename (fix param))
        2pt (vlax-curve-getPointAtParam ename (1+ (fix param))))
      (if (> (abs (- (- (vlax-curve-getDistAtPoint ename 2pt)
            (vlax-curve-getDistAtPoint ename 1pt))
             (distance 2pt 1pt)))
         0.002)
    (setq oblouk T))
      (if oblouk
    (command "_.ARC" 1pt midpt 2pt)                    ;make it line or arc (would be keeped)
    (command "_.LINE" 1pt 2pt ""))
      (setq l2 (cons (entlast) (list (cadr e2))))))            ;if 1st line or arc
  (if (wcmatch (getval 0 e2) "LINE,ARC,CIRCLE")
    (progn
      (entmake (entget (car e2)))                    ;duplicat it
      (setq  l2 (cons (entlast) (list (cadr e2))))))
  (setvar "trimmode" 1)
  (command "_.FILLET" (nentselp p1) l2)                    ;new arc
  (setq er (entlast))
  (command  "_.CHANGE" er "" "_P" "_LAyer" LayerName "")        ; change layer
  (entdel (car l2))                            ;trim substitude of 1st erased
  (if ss (command "_.PEDIT" er "_J" ss "" ""                ;if 2nd was pl, recreate pl
          "_.ERASE" ss ""))                    ;the rest of it (2nd side) erase
  
  (command "_.REGEN")
  (*error* "end")
  (princ)
  )

 

Edited 2 hours ago by SLW210
Added Code Tags!!

[SLW210]

Please use Code Tags for your code in the future. (<>  in the editor toolbar)

 

Where did you find this LISP?

[Ahmed Khaled]

in the link below 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/fillet-and-trim-just-one-entity/td-p/8885891