Topic: "Enhanced" Fillet

[Guest]

A while back there was a LSP (I think it was called something along the lines of 'enhanced fillet') that would allow you to fillet two lines like in the attached picture.  Does anyone have a copy of that floating around they could post?

Thanks in advance!

[Maverick®]

  Like a "Curved Fillet?"

[Guest]

Yeah, I think so....but I don't see how SoftPlan is going to help me. 

[Maverick®]

Just checking.

[LE]

A while back there was a LSP (I think it was called something along the lines of 'enhanced fillet') that would allow you to fillet two lines like in the attached picture.  Does anyone have a copy of that floating around they could post?

Thanks in advance!

Matt;

I remember seeing that routine and I think I wrote something similar, but cannot find it in here....

For now, maybe you can set the option in the fillet command to No Trim, and select your fillet radius and just trim the portion(s) you don't want....

[Adesu]

Hi Matt,
test this code

Code: [Select]

(defun c:test (/ ep pt1 pt2 rad sp ss1 ss2 sse ssx)
  (setq ss1 (entsel "\nSelect a line vertical"))
  (setq pt1 (cadr ss1))
  (setq ss2 (entsel "\nSelect a line horizontal"))
  (setq pt2 (cadr ss2))
  (setq ssx (car ss2))
  (setq sse (entget ssx))
  (setq sp (cdr (assoc 10 sse)))
  (setq ep (cdr (assoc 11 sse)))
  (if
    (and pt1 pt2)
    (progn
      (setq rad 2)
      (command "_fillet" "r" rad "_fillet" pt1 pt2)
      (command "_erase" ssx "")
      ) ; progn
    )   ; if
  (command "_line" sp ep "")
  (princ)
  )


[Guest]

Thanks, I'll take a look.

[t-bear]

I can see this as a handy little routine with some polishing.  It needs to allow for input of a radius and then return to the old radius when the proggy ends.  Unfortunatly, I'm no coder....just an interested observer.  Let me know what you end up with Matt............ :whistle:

[CAB]

Here is a start, quick and dirty.

Code: [Select]

(defun c:efillet (/ e1 e2 elst rad)
  (if
    (and
      (or (not (zerop (getvar "filletrad")))
           (prompt "\nRadius must be > 0."))
      (setq e1 (entsel "\nSelect line to fillet"))
      (setq e2 (entsel "\nSelect line to keep"))
      (setq elst (entget (car e2)))
      (not (command "_fillet" e1 e2))
      (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
    )
     (entmod elst)
  )
  (princ)
)
<edit: added error message>

[A_LOTA_NOTA]

Made a few changes.... still needs work!

Code: [Select]

(defun c:efillet (/ e1 e2 elst OldRad Entz)
  (if (not (zerop (getvar "filletrad")))
    (progn
      (while (not e1)
(initget 1 "Radius")
(setq e1 (entsel "Select first object or [Radius]:"))
(if (or (= e1 "Radius") (= e1 "R"))
  (progn
    (setq OldRad (rtos (getvar "filletrad")))
    (setq NewRad (getreal (strcat "\nSpecify fillet radius < " OldRad " > : ")))
    (if (/= NewRad nil)
      (setvar "filletrad" NewRad)
      )
    (setq e1 nil)
    )
  )
)
      (setq Entz (car e1))
      (redraw Entz 3)
      (while (not e2)
(setq e2 (entsel "\nSelect line to keep"))
)
      (setq elst (entget (car e2)))
      (not (command "_fillet" e1 e2))
      (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
      (entmod elst)
      )
    (progn
      (prompt "\nRadius must be > 0.")
      )
    )
  (princ)
  )

[CAB]

Welcome to TheSwamp.

[A_LOTA_NOTA]

Thanks! Hope you don't mind me adding to your code! I'm learning & figured I could post some code & someone would tell me the correct way to program!

[CAB]

That's what we are here for.

Here is another version.

Code: [Select]

;;  CAB 07.09.07
(defun c:efillet1 (/ e1 e2 elst rad)
  (defun set_radius (/ NewRad)
    (if
      (and
        (not (initget 6))
        (setq NewRad (getdist (strcat "\nSpecify fillet radius < "
                                      (rtos (getvar "filletrad"))
                                      " > : ")))
      )
       (setvar "filletrad" NewRad)
    )
    nil
  )

  (if (zerop (getvar "filletrad"))
    (set_radius)
  )

  (while
    (progn
      (initget "Radius")
      (setq e1 (entsel "\nSelect line to fillet or [Radius]:"))
      (if (= e1 "Radius")
        (set_radius)
      )
      (/= (type e1) 'list)
    )
  )
  (while (not (setq e2 (entsel "\nSelect line to keep"))))
  (setq elst (entget (car e2)))
  (command "_fillet" e1 e2)
  (if (> (getvar "CMDACTIVE") 0)
    (progn
      (command)
      (princ "\nCannot fillet between these two entities.")
    )
    (if (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
      (entmod elst)
    )
  )
  (princ)
)
<edit: changed initget from 7 to 6>

[A_LOTA_NOTA]

I like this one! But if I pick the "Radius" option then don't want to change it so I just press "enter" it doesn't like it!

[CAB]

Oops
I fixed it in the code above by changing initget from 7 to 6.

[A_LOTA_NOTA]

That does it!!

Can I ask what the "nil" does at the end of the "Defun set_radius"?

[CAB]

In one version i needed it to return nil but that version was discarded & I forgot to remove the nil.

[M-dub]

Ok, I have the curse of having to go between AutoCAD and Microstation.  As many know, Micro has a bunch of functionality that we wish AutoCAD had and vise versa.  This is one of them.  Their fillet gives you the option of Trimming the first selection, the second selection, both, or none and it's really handy.  Does anyone know of functionality like this in AutoCAD?

edit: Never mind... I guess that's kind of how CAB's works... I just hadn't used it properly. 

[CADaver]

Ok, I have the curse of having to go between AutoCAD and Microstation.  As many know, Micro has a bunch of functionality that we wish AutoCAD had and vise versa.  This is one of them.  Their fillet gives you the option of Trimming the first selection, the second selection, both, or none and it's really handy.  Does anyone know of functionality like this in AutoCAD?

edit: Never mind... I guess that's kind of how CAB's works... I just hadn't used it properly. 

The fillet command gives you a trim option that will either trim or not trim both selctions.

[M-dub]

The fillet command gives you a trim option that will either trim or not trim both selctions.

Yes, I know about that, but when doing wiring diagrams, I often want to trim one or the other... not both and not ...neither.

My ideal Fillet command would allow me to just be merrily filleting along with the ability to transparently enter "(B)oth, (F)irst, (S)econd" and another handy option would be to Fillet multiple lines to the first selection (with a fence) much like you can do with the Extend command.  Seems to me that the "mUltiple" option should do this, but to be honest, I can't figure out what the heck it does!

[LE]

Yes, I know about that, but when doing wiring diagrams, I often want to trim one or the other... not both and not ...neither.

My ideal Fillet command would allow me to just be merrily filleting along with the ability to transparently enter "(B)oth, (F)irst, (S)econd" and another handy option would be to Fillet multiple lines to the first selection (with a fence) much like you can do with the Extend command.  Seems to me that the "mUltiple" option should do this, but to be honest, I can't figure out what the heck it does!

It is not automatic if you use the built-in command as shown on the image video and later in there it is a routine that does the steps a little more automatic... (I recall that I gave that routine to you?)

[M-dub]

Ahh, this one!

Code: [Select]

(DEFUN C:MFILT ()
  (SETQ A (ENTSEL "\nPick Master Line: ")
B (ENTSEL "\nPick Secondary Line: ")
  )
  (COMMAND "FILLET" A B)
  (WHILE B
    (SETQ B (ENTSEL "\nPick Secondary Line: "))
    (COMMAND "FILLET" A B)
  )
)

See, that's the problem with going back and forth between clients... I forget what I have and where it is!

That one is pretty good too!

[LE]

Ahh, this one!

Code: [Select]

(DEFUN C:MFILT ()
  (SETQ A (ENTSEL "\nPick Master Line: ")
B (ENTSEL "\nPick Secondary Line: ")
  )
  (COMMAND "FILLET" A B)
  (WHILE B
    (SETQ B (ENTSEL "\nPick Secondary Line: "))
    (COMMAND "FILLET" A B)
  )
)

See, that's the problem with going back and forth between clients... I forget what I have and where it is!

That one is pretty good too!

no, this one:

Code: [Select]

;; 10:36 AM 6/19/2006 - le
(vl-load-com)
(defun sort_pts (ptlst)
  (vl-sort
    ptlst
    (function
      (lambda (a b)
(< (car a) (car b))))))

(defun 2area_t (a b c / a0 a1 b0 b1 c0 c1)
  (setq a0 (car a)
a1 (cadr a)
b0 (car b)
b1 (cadr b)
c0 (car c)
c1 (cadr c))
  (+
    (- (* a0 b1) (* a1 b0))
    (- (* a1 c0) (* a0 c1))
    (- (* b0 c1) (* c0 b1))))

(defun C:TST  (/ first ss dist pts i ename elst p10 p11 pt pts _pts ss1 ss2 a b c d int p1 p2
       p3 p4 p5 obj dir)
  (setq first (car (entsel "\nSelect base fillet object: ")))
  (prompt "\nSelect second objects to fillet: \n")
  (setq ss (ssget '((0 . "LINE"))))
  (if (not _dist)
    (setq _dist (getvar "filletrad")))
  (setq dist (getdist (strcat "\nFillet radius <" (rtos _dist) ">: ")))
  (if (not dist)
    (setq dist _dist)
    (setq _dist dist))
  (setvar "filletrad" dist)
  (setq i 0)
  (repeat (sslength ss)
    (setq ename (ssname ss i))
    (setq elst (entget ename))
    (setq p10 (cdr (assoc 10 elst)))
    (setq p11 (cdr (assoc 11 elst)))
    (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2.0)))
    (setq pts (cons (list pt ename (list p10 p11)) pts))
    (setq i (1+ i)))
  (setq _pts (sort_pts (mapcar 'car pts)))
  (setq elst (entget first))
  (setq a (cdr (assoc 10 elst)))
  (setq b (cdr (assoc 11 elst)))
  (setq lst (sort_pts (list a b)))
  (setq a (car lst))
  (setq b (cadr lst))
  (setq ss1 (ssadd))
  (setq ss2 (ssadd))
  (foreach
pt
   _pts
    (setq lst (caddr (assoc pt pts)))
    (setq c (car lst))
    (setq d (cadr lst))
    (setq lst (sort_pts (list c d)))
    (setq c (car lst))
    (setq d (cadr lst))
    (setq int (inters a b c d nil))
    (setq p1 (polar int (angle c d) dist))
    (setq p2 (polar int (angle b a) dist))
    (setq p3 (polar p2 (angle c d) dist))
    (setq p4 (polar p1 (angle a b) dist))
    (setq p5 (polar int (angle a b) dist))
    (if (minusp (2area_t p1 p2 int))
      (progn (command "_.arc" p1 "_c" p3 p2) (ssadd (entlast) ss1))
      (progn (command "_.arc" p2 "_c" p3 p1) (ssadd (entlast) ss1)))
    (if (minusp (2area_t p1 p5 int))
      (progn (command "_.arc" p1 "_c" p4 p5) (ssadd (entlast) ss2))
      (progn (command "_.arc" p5 "_c" p4 p1) (ssadd (entlast) ss2)))
    (setq obj (vlax-ename->vla-object (cadr (assoc pt pts))))
    (vlax-put obj 'startpoint p1)
    (vlax-put obj 'endpoint d))
  (redraw first 3)
  (setq dir (getpoint
      (polar a (angle a b) (/ (distance a b) 2.0))
      "\nSelect end point of base line: "))
  (if (equal b dir 0.0001)
    (command "_.erase" ss2 ""))
  (if (equal a dir 0.0001)
    (command "_.erase" ss1 ""))
  (redraw first 4)
  (princ))


[M-dub]

Hmm!  I guess the TST didn't jump out at me... and hasn't for some time.  That one does a pretty good job as well!


(Wondering how many other Fillet routines I have in my stash!)

[LE]

Hmm!  I guess the TST didn't jump out at me... and hasn't for some time.  That one does a pretty good job as well!


(Wondering how many other Fillet routines I have in my stash!)

Mike;

You can rename it to any name.... I allways use C:TST - when starting a routine

C:TST rename to C:MYFILLET or any other you like 


[ hth ]

[M-dub]

Hmm!  I guess the TST didn't jump out at me... and hasn't for some time.  That one does a pretty good job as well!


(Wondering how many other Fillet routines I have in my stash!)

Mike;

You can rename it to any name.... I allways use C:TST - when starting a routine

C:TST rename to C:MYFILLET or any other you like 


[ hth ]

Definitely.. I just forgot to when I first received it. 

[CAB]

Here is another one to play with.
And No it doesn't repeat!

Code: [Select]

;;  CAB 08.01.07
(defun c:efillet (/ e1 e2 el1 el2 rad)
  (defun set_radius (/ NewRad)
    (if
      (and
        (not (initget 6))
        (setq NewRad (getdist (strcat "\nSpecify fillet radius < "
                                      (rtos (getvar "filletrad"))
                                      " > : ")))
      )
       (setvar "filletrad" NewRad)
    )
  )

  ;;  Get user pick of object to fillet
  (defun linepick (order / mode ent)
    (while ; exit loop if entity is selected or Enter is pressed
      (progn
        (if (and (zerop (getvar "filletrad")) (not (zerop *FilletMode*)))
          (set_radius)
        )
        (setq mode (cdr (assoc *FilletMode* '((0 . "B") (1 . "F") (2 . "S")))))
        (initget "Radius Both First Second")
        (setq ent (entsel (strcat "\nSelect " order
                            " line or [(R)adius, (B)oth, (F)irst, (S)econd]: <"
                            Mode ">")))
        (cond
          ((and (null ent)(= 52 (getvar "ErrNo"))) ; <Enter> only was hit
            (setq ent nil))
          ((= ent "Radius") (set_radius))
          ((= ent "Both") (setq *FilletMode* 0))
          ((= ent "First") (setq *FilletMode* 1))
          ((= ent "Second") (setq *FilletMode* 2))
        )
        (and (/= (type ent) 'list) (not(null ent)))
      )
    )
    ent
  )


  (command "._UNDO" "_Begin")
  (or *FilletMode* (setq *FilletMode* 0))
  ;;  Fillet Mode Options
  ;;  0 = (B)oth
  ;;  1 = (F)irst
  ;;  2 = (S)econd

  (if (and
        (setq e1 (linepick "first"))
        (setq e2 (linepick "second"))
        (setq el1 (entget (car e1)))
        (setq el2 (entget (car e2)))
      )
    (progn
      (command "._fillet" e1 e2)
      (if (> (getvar "CMDACTIVE") 0)
        (progn
          (command)
          (princ "\nCannot fillet between these two entities.")
        )
        (if (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
          (progn
            (if (= *FilletMode* 1) (entmod el2))
            (if (= *FilletMode* 2) (entmod el1))
          )
        )
      )
    )
  )
  (command "._UNDO" "_End")
  (princ)
)
(princ)
(prompt "\nEnhanced Fillet Loaded, Enter eFillet to run.")

[3dwannab]

Thanks, CAB for this.

I modified it a little. See the header for the stuff I changed. Mainly to store the value to its own value in the registry and to loop continuously.

Would love to have the knowledge for this to work with LWPOLYs.

Code: [Select]

;;  CAB 07.09.07
;; http://www.theswamp.org/index.php?topic=17392.msg210552#msg210552
;;
;; Modified by 3dwannab on 2023.06.26
;;  - To not output to commandline
;;  - To save the fillet amount to the registry so it will remember between sessions.
;;  - Keeps looping until the escape key is pressed.
;;  - Match the props of the fillet line to that of the newly created fillet.
;;  - Object checking. Can only pick lines now. Alert box to notify the user.
;;

(vl-load-com)

(defun c:EFillet (/ *error* acDoc e1 e2 elst lastEnt NewRad ssSel var_cmdecho var_matchmode)

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'matchmode var_matchmode)

    (if ssSel
      (progn
        (sssetfirst nil ssSel)
        (princ (strcat (itoa (sslength ssSel)) (if (> (sslength ssSel) 1) " <<< fillets" " <<< fillet") " have been created:\n"))
      )
    )
  )

  (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_matchmode (getvar "matchmode"))

  (setvar 'cmdecho 0)
  (setvar 'matchmode 261631) ;; Matches everything

  (setq NewRad (atof (cond ((getenv "MyFilletProgram")) ("1")))) ;; Get saved offset from registry or default to 1
  (setq ssSel (ssadd))

  (while T  ;; Loops until escape key is pressed

    (if (setq NewRad (cond ((getdist (strcat "\nFillet Radius <" (vl-princ-to-string NewRad) ">:\n"))) (NewRad)))  ;; Prompt for radius if nil use default

      (progn

        (setenv "MyFilletProgram" (vl-princ-to-string NewRad)) ;; Write our default offset to registry
        (setvar "filletrad" NewRad)

        (while
          (not
            (and
              (setq e1 (entsel "\nSelect line to fillet:\n"))
              (or (vl-position (cdr (assoc 0 (entget (car e1)))) '("LINE"))
                  (alert (strcat "Invalid object! " (cdr (assoc 0 (entget (car e1)))) " is selected!" "\n\nYou must pick a LINE."))
              ) ;; or
              (setq e2 (entsel "\nSelect line to keep:\n"))
              (or (vl-position (cdr (assoc 0 (entget (car e2)))) '("LINE"))
                  (alert (strcat "Invalid object! " (cdr (assoc 0 (entget (car e2)))) " is selected!" "\n\nYou must pick a LINE."))
              ) ;; or
            ) ;; and
          ) ;; not
        ) ;; while

        (setq elst (entget (car e2)))

        (command "_fillet" e1 e2)

        (if (> (getvar "CMDACTIVE") 0)
          (progn
            (command)
            (princ "\nCannot fillet between these two entities.")
          )
          (if (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
            (progn
              (entmod elst)
              (command "_.matchprop" "_non" e1 "_non" (entlast) "")
              (ssadd (entlast) ssSel)
            )
          )
        ) ;; if cmdactive > 0
      ) ;; progn
    ) ;; if
  ) ;; while T

  (vla-EndUndoMark acDoc)
  (*error* nil)
  (princ)
)
; (c:EFillet)