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
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
