Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Fillet through a point lisp

18 REPLIES 18
SOLVED
Reply
Message 1 of 19
zasanil
1404 Views, 18 Replies

Fillet through a point lisp

I am trying to fillet an object (lines, polylines or combination of both) using a script I found that lets you select 2 lines and a point along one of the lines.Sometimes it works when I pick 2 objects and other times it wont work picking the same 2 objects.

The script is using the _circle (tan tan point) to get the radius and then filleting to that radius, but this method isn't always reliable for some reason. I was wondering if someone had a lisp out there that worked better or more consistant.

 

Here is the lisp I found that I've been trying to use:

 

;;; By Irneb
;;; http://www.theswamp.org/index.php?topic=41775.0;all
;;; Creates a fillet but lets you pick a point that will lie on the arc.
;;; This is usefull when the radius is not known.
(defun c:FP (/ l1 l2 pt ed)
  (if (and (setq l1 (entsel "\nPick first line: "))
           (setq l2 (entsel "\nPick second line: "))
           (setq pt (getpoint "\nPick point passing through circle: ")))
    (progn (command "._circle" "_3P" "_tan" (cadr l1) "_tan" (cadr l2) "_non" pt)
           (setq ed (entget (entlast)))
           (entdel (entlast))
           (command "._fillet" "_radius" (cdr (assoc 40 ed)) "._fillet" l1 l2)))
  (princ)
)

 I've also attached an example drawing that I've been using to test. My goal is to fillet all the lines / polylines so that the end of the fillet stops at the xline. It would be nice if there was an option to do them all at once or one at a time.

 

Thanks for any help!

Dan Nicholson C.I.D.
PCB Design Engineer
18 REPLIES 18
Message 2 of 19
stevor
in reply to: zasanil

Try setting the Object Snap Mode to 0,

(setvar 'osmode 0)

before the command, in your routine.

S
Message 3 of 19
zasanil
in reply to: stevor

I tried what you suggested but the result still seems to be the same.

Dan Nicholson C.I.D.
PCB Design Engineer
Message 4 of 19
hmsilva
in reply to: zasanil

Irneb's code slightly modified

 

;;; By Irneb
;;; http://www.theswamp.org/index.php?topic=41775.0;all
;;; Creates a fillet but lets you pick a point that will lie on the arc.
;;; This is usefull when the radius is not known.
;;; Add lipt and l2pt by hms
(defun c:FP (/ l1 l1pt l2 l2pt pt ed)
  (if (and (setq l1 (entsel "\nPick first line: "))
           (setq l2 (entsel "\nPick second line: "))
           (setq pt (getpoint "\nPick point passing through circle: "))
	   (setq l1pt (osnap (cadr l1) "_NEA"))
	   (setq l2pt (osnap (cadr l2) "_NEA")))
    (progn (command "._circle" "_3P" "_tan" l1pt "_tan" l2pt "_non" pt)
           (setq ed (entget (entlast)))
           (entdel (entlast))
           (command "._fillet" "_radius" (cdr (assoc 40 ed)) "._fillet" l1 l2)))
  (princ)
)

 

HTH

Henrique

EESignature

Message 5 of 19
Kent1Cooper
in reply to: zasanil


@zasanil wrote:

I tried what you suggested but the result still seems to be the same.


The unreliability seems to be that it sometimes chooses the relational position that's along an extension of one straight element on the other side of the other straight element from what you intend.  In the case of a relationship like that in your sample drawing, that means the resulting tangent Circle, and therefore the Fillet radius it uses, is smaller than what you intend.  It might possibly be affected by where you pick things -- try picking with the element in the edge of the pickbox, but the center of the pickbox decidedly on the side toward the inside of the desired arc.  Of course, even if that gives reliable results, it wouldn't be possible with a lots-at-once selection, if a way can be devised to allow that.

 

I can't work on figuring it out right now, but it should be possible to calculate the required radius, rather than to draw an actual Circle to determine it, and to take the alternative possibilities into consideration and reliably pick the "right" one.

Kent Cooper, AIA
Message 6 of 19
zasanil
in reply to: Kent1Cooper

HTH,

I tried the new code but I still see the same unreliable results as before.

 

Kent,

I tried with the pickbox center on the right side but with the same results.

Ihave tried researching a formula for determining the radius of a circle that tangent to 2 lines and a point but the formula becomes very long and nasty. I wish autocad had an option to pick the correct side when doing the circle_3P command.

 

For reference I was looking at the formulas here: http://www.arcenciel.co.uk/geometry/

trying to see if there was one that I could use.

Dan Nicholson C.I.D.
PCB Design Engineer
Message 7 of 19
hmsilva
in reply to: zasanil

Only works with lines...
Quick and dirty, and not really tested...

 

(defun c:demo (/      ANGB   L1	    L1ANG  L1P1	  L1P2	 L2	L2ANG  L2P1
	       L2P2   OLD_RAD	    PT1	   PT_INT RAD	 SS	SS1    TAN
	       TG
	      )

  (defun tan (ang)
    (/ (sin ang) (cos ang))
  )

  (if
    (and
      (setq ss (ssget ":s:e" '((0 . "line"))))
      (setq ss1 (ssget ":s:e" '((0 . "line"))))
      (setq pt1 (getpoint "\nPick, on the line, the initial point of arc: "))
    )
     (progn
       (setq l1	   (entget (ssname ss 0))
	     l1p1  (cdr (assoc 10 l1))
	     l1p2  (cdr (assoc 11 l1))
	     l2	   (entget (ssname ss1 0))
	     l2p1  (cdr (assoc 10 l2))
	     l2p2  (cdr (assoc 11 l2))
	     l1ang (angle l1p1 l1p2)
	     l2ang (angle l2p1 l2p2)
	     angb  (abs (- l1ang l2ang))
       )
       (if (setq pt_int (inters l1p1 l1p2 l2p1 l2p2 nil))
	 (progn
	   (setq tg	 (distance pt_int pt1)
		 rad	 (abs (/ tg (tan (/ angb 2))))
		 old_rad (getvar 'FILLETRAD)
	   )
	   (if (and (>= (distance l1p1 l1p2) tg)
		    (>= (distance l2p1 l2p2) tg)
	       )
	     (progn
	       (setvar 'FILLETRAD rad)
	       (command "_.fillet" ss ss1)
	       (setvar 'FILLETRAD old_rad)
	     )
	     (prompt "\nRadius is too large!")
	   )
	 )
	 (prompt "\nWas not possible to fillet those lines!!!")
       )
     )
  )
  (princ)
)

 

Hope that helps
Henrique

EESignature

Message 8 of 19
zasanil
in reply to: hmsilva

Henrique,

That works really well! Everything I tested it on seems to be correct. I can definitely use it for now while I get it fleshed out more (polylines, error capturing, turning result into polylines, etc).

Thanks!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 9 of 19
hmsilva
in reply to: zasanil

You're welcome, Dan
Glad I could help

Henrique

EESignature

Message 10 of 19
zasanil
in reply to: zasanil

I might have spoke too soon Henrique. I was using the script more today and it was only getting about have the radii correct. The wrong ones seem to suffer the same problem as before (smaller radius). Your program was getting more of the arcs correct though than the first script I was using.
Dan Nicholson C.I.D.
PCB Design Engineer
Message 11 of 19
hmsilva
in reply to: zasanil


@zasanil wrote:
I might have spoke too soon Henrique. I was using the script more today and it was only getting about have the radii correct. The wrong ones seem to suffer the same problem as before (smaller radius). Your program was getting more of the arcs correct though than the first script I was using.

Hi Dan,
after reading your post I tested the code in your dwg and I could reproduce that situation.
I did unmark the 'ACCEPT AS SOLUTION' from my post!
I'll think in another approach...

 

Henrique

EESignature

Message 12 of 19
hmsilva
in reply to: zasanil

Code revised...

(defun c:demo (/      ANGB   L1     L1ANG  L1P1   L1P2   L2     L2ANG  L2P1
               L2P2   OLD_RAD       PT1    PT_INT RAD    SS     SS1    TAN
               TG
              )

  (defun tan (ang)
    (/ (sin ang) (cos ang))
  )

  (if
    (and
      (setq ss (ssget ":s:e" '((0 . "line"))))
      (setq ss1 (ssget ":s:e" '((0 . "line"))))
      (setq pt1 (getpoint "\nPick, on the line, the initial point of arc: "))
    )
     (progn
       (setq l1   (entget (ssname ss 0))
             l1p1 (cdr (assoc 10 l1))
             l1p2 (cdr (assoc 11 l1))
             l2   (entget (ssname ss1 0))
             l2p1 (cdr (assoc 10 l2))
             l2p2 (cdr (assoc 11 l2))
       )
       (if (setq pt_int (inters l1p1 l1p2 l2p1 l2p2 nil))
         (progn
           (setq tg (distance pt_int pt1))
           (if (< (distance pt_int l1p1) (distance pt_int l1p2))
             (setq l1ang (angle l1p2 l1p1))
             (setq l1ang (angle l1p1 l1p2))
           )
           (if (< (distance pt_int l2p1) (distance pt_int l2p2))
             (setq l2ang (angle l2p1 l2p2))
             (setq l2ang (angle l2p2 l2p1))
           )
           (setq angb    (abs (- l1ang l2ang))
                 rad     (abs (/ tg (tan (/ angb 2))))
                 old_rad (getvar 'FILLETRAD)
           )
           (if (and (>= (distance l1p1 l1p2) tg)
                    (>= (distance l2p1 l2p2) tg)
               )
             (progn
               (setvar 'FILLETRAD rad)
               (command "_.fillet" ss ss1)
               (setvar 'FILLETRAD old_rad)
             )
             (prompt "\nRadius is too large!")
           )
         )
         (prompt "\nWas not possible to fillet those lines!!!")
       )
     )
  )
  (princ)
)

 

hope that helps

Henrique

EESignature

Message 13 of 19
zasanil
in reply to: hmsilva

I tested it with a few items and this seems to be it. Very nice work Henrique!

Do you think you could add the other features such as being able to select polylines or lines and joining the results? Maybe an options to keep filliting until the user is finished? I'm in the process of learning the lisp language so it would take me a few weeks to figure out enough of it to write it probably. I'm still a week or so fresh on trying to teach myself this.

 

Thanks for all the work you have done!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 14 of 19
hmsilva
in reply to: zasanil

You're welcome, Dan.

 

To to include polylines would be necessary a lot more code lines, and more time to write it...

The attached code only works with lines,  keep filliting until the user is finished and joining the results.

(defun c:demo (/ ANGB L1 L1ANG L1P1 L1P2 L2 L2ANG L2P1 L2P2 OLD_PED OLD_RAD PT1 PT_INT RAD SS SS1
               TAN TG)

  (defun tan (ang)
    (/ (sin ang) (cos ang))
  )

  (while
    (and
      (setq ss (ssget ":s:e" '((0 . "line"))))
      (setq ss1 (ssget ":s:e" '((0 . "line"))))
      (setq pt1 (getpoint "\nPick, on the line, the initial point of arc: "))
    )
     (progn
       (setq l1   (entget (ssname ss 0))
             l1p1 (cdr (assoc 10 l1))
             l1p2 (cdr (assoc 11 l1))
             l2   (entget (ssname ss1 0))
             l2p1 (cdr (assoc 10 l2))
             l2p2 (cdr (assoc 11 l2))
       )
       (if (setq pt_int (inters l1p1 l1p2 l2p1 l2p2 nil))
         (progn
           (setq tg (distance pt_int pt1))
           (if (< (distance pt_int l1p1) (distance pt_int l1p2))
             (setq l1ang (angle l1p2 l1p1))
             (setq l1ang (angle l1p1 l1p2))
           )
           (if (< (distance pt_int l2p1) (distance pt_int l2p2))
             (setq l2ang (angle l2p1 l2p2))
             (setq l2ang (angle l2p2 l2p1))
           )
           (setq angb    (abs (- l1ang l2ang))
                 rad     (abs (/ tg (tan (/ angb 2))))
                 old_rad (getvar 'FILLETRAD)
                 old_ped (getvar 'PEDITACCEPT)
           )
           (if (and (>= (distance l1p1 l1p2) tg)
                    (>= (distance l2p1 l2p2) tg)
               )
             (progn
               (setvar 'PEDITACCEPT 1)
               (setvar 'FILLETRAD rad)
               (command "_.fillet" ss ss1)
               (command "_.pedit" "_L" "_J" "_ALL" "" "")
               (setvar 'FILLETRAD old_rad)
               (setvar 'PEDITACCEPT old_ped)
             )
             (prompt "\nRadius is too large!")
           )
         )
         (prompt "\nWas not possible to fillet those lines!!!")
       )
     )
  )
  (princ)
)

 

hope that helps

Henrique

EESignature

Message 15 of 19
zasanil
in reply to: hmsilva

Thanks again Henrique. That does help very much!

 

Dan Nicholson C.I.D.
PCB Design Engineer
Message 16 of 19
hmsilva
in reply to: zasanil

You're welcome, Dan.
Glad I could help

Henrique

EESignature

Message 17 of 19
hmsilva
in reply to: zasanil


@zasanil wrote:

...

Do you think you could add the other features such as being able to select polylines or lines and joining the results? Maybe an options to keep filliting until the user is finished?

...


Dan, this is as far as I will go.

Only works with lines and straight lwpolylines segments.

Just did some tests, but should work as expected.

 

(defun c:demo (/       ANGB    GET_PTS L1ANG   L1P1    L1P2    L2ANG   L2P1    L2P2    LST1
               LST2    OBJ     OBJ1    OBJ1PT  OBJPT   OLD_PED OLD_RAD PTPK    PT_INT  RAD
               SEL     SEL1    SS      SS1     TAN     TG
              )


  (defun tan (ang)
    (/ (sin ang) (cos ang))
  )

  (defun get_pts (pt vla_obj / lst par pt1 pt2)
    (cond ((= (vla-get-ObjectName vla_obj) "AcDbPolyline")
           (setq par (fix (vlax-curve-getParamAtPoint vla_obj pt)))
           (if (= (vla-getbulge vla_obj par) 0)
             (setq pt1 (vlax-curve-getPointAtParam vla_obj par)
                   lst (cons pt1 lst)
                   pt2 (vlax-curve-getPointAtParam vla_obj (1+ par))
                   lst (cons pt2 lst)
                   lst (cons "" lst)
                   lst (reverse lst)
             )
             (prompt "\nNot a straight segment!")
           )
          )
          ((= (vla-get-ObjectName vla_obj) "AcDbLine")
           (setq pt1 (vlax-curve-getEndPoint vla_obj)
                 lst (cons pt1 lst)
                 pt2 (vlax-curve-getStartPoint vla_obj)
                 lst (cons pt2 lst)
           )
          )
          (T
           (prompt "\nNot a valid object!")
          )
    )
  )

  (while
    (and
      (setq sel (entsel "\nSelect a LINE or a LWPOLYLINE in a straight segment: "))
      (setq obj (vlax-ename->vla-object (car sel)))
      (setq objpt (vlax-curve-getClosestPointTo obj (cadr sel) nil))
      (setq ss (ssget objpt))
      (setq lst1 (get_pts objpt obj))
      (setq sel1 (entsel "\nSelect the other LINE or a LWPOLYLINE in a straight segment: "))
      (setq obj1 (vlax-ename->vla-object (car sel1)))
      (setq obj1pt (vlax-curve-getClosestPointTo obj1 (cadr sel1) nil))
      (setq ss1 (ssget obj1pt))
      (setq lst2 (get_pts obj1pt obj1))
      (setq ptpk (getpoint "\nPick, on the line, the initial point of arc: "))
    )
     (if (and (listp lst1)
              (listp lst2)
         )
       (progn
         (setq l1p1 (car lst1)
               l1p2 (cadr lst1)
               l2p1 (car lst2)
               l2p2 (cadr lst2)
         )
         (if (setq pt_int (inters l1p1 l1p2 l2p1 l2p2 nil))
           (progn
             (setq tg (distance pt_int ptpk))
             (if (< (distance pt_int l1p1) (distance pt_int l1p2))
               (setq l1ang (angle l1p2 l1p1))
               (setq l1ang (angle l1p1 l1p2))
             )
             (if (< (distance pt_int l2p1) (distance pt_int l2p2))
               (setq l2ang (angle l2p1 l2p2))
               (setq l2ang (angle l2p2 l2p1))
             )
             (setq angb    (abs (- l1ang l2ang))
                   rad     (abs (/ tg (tan (/ angb 2))))
                   old_rad (getvar 'FILLETRAD)
             )
             (if (and (>= (distance l1p1 l1p2) tg)
                      (>= (distance l2p1 l2p2) tg)
                 )
               (progn
                 (setvar 'FILLETRAD rad)
                 (command "_.fillet" ss ss1)
                 (setvar 'FILLETRAD old_rad)
                 (if (and (= (length lst1) 2)
                          (= (length lst2) 2)
                     )
                   (progn
                     (setq old_ped (getvar 'PEDITACCEPT))
                     (setvar 'PEDITACCEPT 1)
                     (command "_.pedit" "_L" "_J" "_ALL" "" "")
                     (setvar 'PEDITACCEPT old_ped)
                   )
                 )
               )
               (prompt "\nRadius is too large!")
             )
           )
           (prompt "\nWas not possible to fillet those objects!!!")
         )
       )
       (progn
         (if (= (type lst1) 'STR)
           (princ lst1)
         )
         (if (= (type lst2) 'STR)
           (princ lst2)
         )
       )
     )
  )
  (princ)
)

 

Henrique

 

EESignature

Message 18 of 19
zasanil
in reply to: hmsilva

Henrique,

That code performs beautifully! It does exactly what I wanted and will definently be a timesaver.

Thank you!

 

Dan Nicholson C.I.D.
PCB Design Engineer
Message 19 of 19
hmsilva
in reply to: zasanil

You're welcome, Dan.

Henrique

EESignature

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost