Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Valued Contributor
DavidGarrigues5269
Posts: 63
Registered: ‎12-10-2004
Message 1 of 8 (943 Views)
Accepted Solution

Tangent Line and pass through two points

943 Views, 7 Replies
08-20-2012 10:52 AM

Hey Everyone,

We have a need to select a tangent line/polyline etc and then select two other points we would then like to have the program draw an arc through the two points and yet still be tangent to the initial line/polyline that we picked.  We don't care what the radius is as we believe there is only one solution anyway.  It would be wonderful if we could just use the Arc command and select start>Second Point> then just use the Tangent Osnap but I guess that is out of the question :-)

 

The only code that I have come across that even resembles this only allows for one point not two (STILL VERY HANDY AND VERY SLICK)

(vl-load-com)
(defun near_vertex_arr (obj / dxf_obj e_next obj_vlax pt_sel par pt_first pt_snd i bulge)
  ;bruno.valsecchi
  ;Re: ARC - START, TAN, RADIUS
 (setq dxf_obj (entget (car obj)))
 (setq
   obj_vlax (vlax-ename->vla-object (car obj))
   pt_sel (osnap (cadr obj) "_near")
 )
 (if (null pt_sel)
   (progn
     (while (null (setq e_next (entsel "\nInaccuracy determination of the segment, Re-select: "))))
     (setq pt_sel (osnap (cadr e_next) "_near"))
   )
 )
 (setq
   pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans pt_sel 1 0))
   par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
   pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
   pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 0 1)
   i 0
 )
 (while (or (/= (caar dxf_obj) 42) (if (< i (fix par)) (setq i (1+ i))))
   (setq bulge (cdadr dxf_obj) dxf_obj (cdr dxf_obj))
 )
 (list pt_first pt_snd bulge)
)
;(defun c:arc_pt_rad_tg ( / z_dir pt_start rad e_cir ent dxf_ent p_10 p_11 straight l_2pt id_rad v1 v2 det_or dir test obj_line obj_cir lst_int pc1 pc2 pt_end1 pt_end2 ss1 ss2 key)

(defun c:TangentArcThroughPoint ( / z_dir pt_start rad e_cir ent dxf_ent p_10 p_11 straight l_2pt id_rad v1 v2 det_or dir test obj_line obj_cir lst_int pc1 pc2 pt_end1 pt_end2 ss1 ss2 key)
 (setq z_dir (trans '(0 0 1) 1 0 T) dxf_ent nil)
 (while (null dxf_ent)
   (while (null (setq ent (entsel "\nSelect the object for the tangency of the arc : "))))
   (setq dxf_ent (entget (car ent)))
   (if (or (not (member (cdr (assoc 0 dxf_ent)) '("LINE" "ARC" "CIRCLE" "LWPOLYLINE"))) (not (equal (cdr (assoc 210 dxf_ent)) z_dir 1E-8)))
     (progn (setq dxf_ent nil) (princ "\nIs not a line, arc, circle or lwpolyline , or not parallel with the current SCU!"))
   )
 )
 (cond
   ((eq (cdr (assoc 0 dxf_ent)) "LINE")
     (setq p_10 (cdr (assoc 10 dxf_ent)))
     (setq p_11 (cdr (assoc 11 dxf_ent)))
     (setq straight T)
   )
   ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
     (setq l_2pt (near_vertex_arr ent))
     (if (zerop (caddr l_2pt))
       (setq
         p_10 (trans (car l_2pt) 1 0)
         p_11 (trans (cadr l_2pt) 1 0)
         straight T
       )
       (setq
         id_rad (/ (distance (car l_2pt) (cadr l_2pt)) (sin (* 2.0 (atan (caddr l_2pt)))) 2.0)
         p_10 (trans (polar
           (car l_2pt)
           (- (angle (car l_2pt) (cadr l_2pt)) (- (* 2 (atan (caddr l_2pt))) (/ pi 2)))
           id_rad
         ) 1 0)
         straight nil
       )
     )
   )
   (T
     (setq p_10 (trans (cdr (assoc 10 dxf_ent)) (car ent) 0) id_rad (cdr (assoc 40 dxf_ent)) straight nil)
   )
 )
 (while (null pt_start)
   (initget 9)
   (setq pt_start (trans (getpoint "\nStarting point of the arc : ") 1 0))
   (if (assoc 38 dxf_ent)
    (if (not (equal (+ (caddr (trans (list 0 0 0) 0 1)) (cdr (assoc 38 dxf_ent))) 0.0 1E-8))
     (setq pt_start (list (car pt_start) (cadr pt_start) (cdr (assoc 38 dxf_ent))))
    )
   )
   (cond
     (straight
       (setq
         v1 (mapcar '- p_10 p_11)
         v2 (mapcar '- p_10 pt_start)
         det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2))
       )
       (if (equal det_or 0.0 1E-8)
         (progn
           (princ "\nThe starting point cannot belong to the tangent")
           (setq pt_start nil)
         )
       )
     )
     (T
       (if (equal (polar (trans p_10 0 1) (angle (trans p_10 0 1) (trans pt_start 0 1)) id_rad) (trans pt_start 0 1) 1E-8)
         (progn
           (princ "\nThe starting point cannot belong to the tangent")
           (setq pt_start nil)
         )
       )
     )
   )
 )
 (initget 67)
 (setq rad (getdist (trans pt_start 0 1) "\nRay of the arc \(or enter the radius\): "))
 (entmake
   (list
     (cons 0 "CIRCLE")
     (cons 100 "AcDbEntity")
     (cons 60 1)
     (cons 100 "AcDbCircle")
     (cons 10 (trans pt_start 0 z_dir))
     (cons 40 rad)
     (cons 210 z_dir)
   )
 )
 (setq e_cir (entlast) dxf_ent nil)
 (cond
   (straight
     (cond
       ((> det_or 0.0) (setq dir (+ (angle (trans p_10 0 1) (trans p_11 0 1)) (/ pi 2))))
       ((< det_or 0.0) (setq dir (- (angle (trans p_10 0 1) (trans p_11 0 1)) (/ pi 2))))
     )
     (entmake
       (list
         (cons 0 "LINE")
         (cons 100 "AcDbEntity")
         (cons 60 1)
         (cons 100 "AcDbLine")
         (cons 10 (trans (polar (trans p_10 0 1) dir rad) 1 0))
         (cons 11 (trans (polar (trans p_11 0 1) dir rad) 1 0))
         (cons 210 z_dir)
       )
     )
     (if (inters (trans pt_start 0 1) (polar (trans pt_start 0 1) (+ dir pi) (* 2.0 rad)) (trans p_10 0 1) (trans p_11 0 1) T)
       (setq test T)
       (setq test nil)
     )
   )
   (T
     (if (>= (distance (trans p_10 0 1) (trans pt_start 0 1)) (abs id_rad))
       (setq id_rad (+ (abs id_rad) rad) det_or T)
       (setq id_rad (- (abs id_rad) rad) det_or nil)
     )
     (entmake
       (list
         (cons 0 "CIRCLE")
         (cons 100 "AcDbEntity")
         (cons 60 1)
         (cons 100 "AcDbCircle")
         (cons 10 (trans p_10 0 z_dir))
         (cons 40 (abs id_rad))
         (cons 210 z_dir)
       )
     )
     (if
       (or
         (> (distance (trans p_10 0 1) (trans pt_start 0 1)) (+ (abs id_rad) rad))
         (< (distance (trans p_10 0 1) (trans pt_start 0 1)) (- (abs id_rad) rad))
         (< (distance (trans p_10 0 1) (trans pt_start 0 1)) (- rad (abs id_rad)))
       )
       (setq test nil)
       (setq test T)
     )
   )
 )
 (cond
   (test
     (setq obj_line (vlax-ename->vla-object (entlast)))
     (setq obj_cir (vlax-ename->vla-object e_cir))
     (setq lst_int (vlax-variant-value (vla-IntersectWith obj_line obj_cir 1)))
     (entdel (entlast))
     (entdel e_cir)
     (cond
       ((> (vlax-safearray-get-u-bound lst_int 1) 0)
         (setq lst_int (vlax-safearray->list lst_int))
         (setq pc1 (trans (list (nth 0 lst_int) (nth 1 lst_int) (nth 2 lst_int)) 0 1))
         (if (> (length lst_int) 3)
           (setq pc2 (trans (list (nth 3 lst_int) (nth 4 lst_int) (nth 5 lst_int)) 0 1))
           (setq pc2 pc1)
         )
         (if straight
           (setq
             pt_end1 (inters pc1 (polar pc1 dir rad) (trans p_10 0 1) (trans p_11 0 1) nil)
             pt_end2 (inters pc2 (polar pc2 dir rad) (trans p_10 0 1) (trans p_11 0 1) nil)
           )
           (if det_or
             (setq
               pt_end1 (polar pc1 (angle pc1 (trans p_10 0 1)) rad)
               pt_end2 (polar pc2 (angle pc2 (trans p_10 0 1)) rad)
             )
             (setq
               pt_end1 (polar pc1 (angle (trans p_10 0 1) pc1) rad)
               pt_end2 (polar pc2 (angle (trans p_10 0 1) pc2) rad)
             )
           )
         )
         (setvar "CMDECHO" 0)
         (setq old_osmd (getvar "osmode"))
         (setvar "osmode" 0)
         (if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
         (command "_.arc" "_ce" pc1 (trans pt_start 0 1) pt_end1)
         (setq ss1 (ssget "_L"))
         (command "_.arc" "_ce" pc1 pt_end1 (trans pt_start 0 1))
         (ssadd (entlast) ss1)
         (command "_.arc" "_ce" pc2 (trans pt_start 0 1) pt_end2)
         (setq ss2 (ssget "_L"))
         (command "_.arc" "_ce" pc2 pt_end2 (trans pt_start 0 1))
         (ssadd (entlast) ss2)
         (setvar "osmode" old_osmd)
         (if (and ss1 ss2 (= 0 (getvar "CMDACTIVE")))
           (progn
             (sssetfirst nil ss2)
             ;(princ "\n<Move Cursor> for select; <Return>/[Space]/Right-click to finish !.")
             (princ "\nMove Cursor over items to delete; <Return>/[Space]/Right-click to finish !.")
             (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
               (cond
                 ((eq (car key) 5)
                   (if (< (distance pc1 (cadr key)) (distance pc2 (cadr key)))
                     (sssetfirst nil ss1)
                     (sssetfirst nil ss2)
                   )
                 )
               )
             )
           )
         )
         (command "_.erase")
         (setvar "CMDECHO" 1)
         (princ "\n*Cut's circle at the obliged points!*!\n")
       )
       (T (princ "\nValid intersections could not be found!"))
     )
   )
   (T
     (entdel (entlast))
     (entdel e_cir)
     (princ "\nNo intersections!")
   )
 )
 (prin1)
)

 

How does everyone else hande this?  By they way... I dont care what language it is written in :-)

 

thanks!!

dg 

 

*Expert Elite*
Kent1Cooper
Posts: 5,264
Registered: ‎09-13-2004
Message 2 of 8 (934 Views)

Re: Tangent Line and pass through two points

08-20-2012 11:46 AM in reply to: DavidGarrigues5269

DavidGarrigues5269 wrote:

.... We have a need to select a tangent line/polyline etc and then select two other points we would then like to have the program draw an arc through the two points and yet still be tangent to the initial line/polyline that we picked.  We don't care what the radius is as we believe there is only one solution anyway. .... 


There will be two solutions [see attached].  The yellow Line is what the Arcs/Circles [green hidden-line] are supposed to be tangent to, and the two specified points are the red ones.  The centers of both Arcs/Circles [magenta points] will always lie on the perpendicular bisector of the line between the specified two points [blue center-lines].  I suspect it's going to be a trial-and-error-and-recalculate-until-it-gets-within-a-tolerance-value solution -- I've done something similar before, making an Arc tangent to two things with the point of tangency on one of them specified.

 

Will it always be either a Line or a line segment of a Polyline that you want it tangent to?  Or might it sometimes be an arc segment [or an Arc or a Circle], or worse yet, a Polyline that's been spline-curved?

 

EDIT:  Here's [at the end of the thread] that other routine [it took me a while to find it], in case it gives you any ideas, or a starting point:

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/draw-an-arc-tangent-to-2-lines/td-p/2...

Kent Cooper
*Expert Elite*
hmsilva
Posts: 2,667
Registered: ‎12-17-2004
Message 3 of 8 (922 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:09 PM in reply to: DavidGarrigues5269

DavidGarrigues5269 said:

...It would be wonderful if we could just use the Arc command and select start>Second Point> then just use the Tangent Osnap but I guess that is out of the question :-)

 

use circle, 3 ponts, allows you to use, point, point, tangent, or tangent, point, point.

 

Henrique

Valued Contributor
DavidGarrigues5269
Posts: 63
Registered: ‎12-10-2004
Message 4 of 8 (919 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:19 PM in reply to: hmsilva

Shut the front door!  Why on earth that works and not the arc I do not know but sheesh! Thanks a bunch!!!

 

dg

Valued Contributor
DavidGarrigues5269
Posts: 63
Registered: ‎12-10-2004
Message 5 of 8 (916 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:21 PM in reply to: Kent1Cooper

Hey thanks a bunch Kent... I could not get this to do exactly what I wanted but I will for sure keep it around for some other stuff :-)

*Expert Elite*
hmsilva
Posts: 2,667
Registered: ‎12-17-2004
Message 6 of 8 (911 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:29 PM in reply to: DavidGarrigues5269

You're welcome.

 

Henrique

*Expert Elite*
Kent1Cooper
Posts: 5,264
Registered: ‎09-13-2004
Message 7 of 8 (905 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:41 PM in reply to: DavidGarrigues5269

DavidGarrigues5269 wrote:

Hey thanks a bunch Kent... I could not get this to do exactly what I wanted but I will for sure keep it around for some other stuff :-)


No, it doesn't do what you're asking here, but was an example of something that makes a guess at a location, tests the result, and fine-tunes the guess until the result gets to within a tolerance.  I think that's still necessary for what that thread was about, but for this one, I'm surprised I didn't think of Henrique's answer.  I was aware you could use tangent Osnap three times for a 3-point Circle [I even have a shortcut routine posted on Cadalyst CAD Tips #3875, to feed all those tangent Osnap calls in for you], so it probably should have occurred to me to try a combination of point and tangent input.  It's a good thing he sent that in, because otherwise I probably would have wasted an evening or two coming up with something, unnecessarily....

Kent Cooper
Valued Contributor
DavidGarrigues5269
Posts: 63
Registered: ‎12-10-2004
Message 8 of 8 (900 Views)

Re: Tangent Line and pass through two points

08-20-2012 12:51 PM in reply to: Kent1Cooper

I am already embarrased... thank goodness he showed up, I have already now truly "wasted" too much time on an extremely simple solution... btw.. here is some fun stuff.

http://whistleralley.com/tangents/tangents.htm

 

thanks again!

dg

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community