lisp to generate tangent lines for a selected arc

[vnk17200414]

is it possible to do so.

could anyone write for me???

find the attached picture for more information.

[fixo]

is it possible to do so.

could anyone write for me???

find the attached picture for more information.

Is this what you loking for?

 
;;ARL.lsp
(defun ltype-load (ltyp)
(if (not (tblsearch "ltype" ltyp))
(command "._-linetype" "_l"  ltyp
(findfile 
(if (= (getvar "measurement") 0)
  "acad.lin"
  "acadiso.lin")) ""))
(princ)
  )
(defun C:ARL (/ ang1 ang2 cent elist en end ent p1 p2 pc start)
 
  (ltype-load "CENTER");<--change linetype to suit
  (setq ltp (getvar "celtype"))
  (setvar "celtype" "CENTER");<--change linetype to suit
  (while
  (setq ent (entsel "\nSelect an arc with accuracy (or press Enter to Exit)>>"))
  (setq en (car ent)
 elist (entget en)
 cent (cdr (assoc 10 elist)))
(setq start (vlax-curve-getstartpoint en)
      end (vlax-curve-getendpoint en)
      )
(command "._line" "_non" cent "_non" start ""
  "._line" "_non" cent "_non" end ""
  )
  (setq ang1 (+ (angle cent start)(/ pi 2))
 p1 (polar start ang1 1)
 ang2 (- (angle cent end)(/ pi 2))
 p2 (polar end ang2 1)
 pc (inters start p1 end p2 nil)
 )
(command "._line" "_non" start "_non" pc ""
  "._line" "_non" end "_non" pc ""
  )
)
  (setvar "celtype" ltp)
  (princ)
  )
(princ "\n   *** Type ARL to execute   ***")
(prin1)
(vl-load-com)

~'J'~

[vnk17200414]

exactly
thanks for the lisp
is it possible to do this for mutiple arcs at a single time?

[fixo]

exactly
thanks for the lisp
is it possible to do this for mutiple arcs at a single time?

Yes

 
(defun ltype-load (ltyp)
(if (not (tblsearch "ltype" ltyp))
(command "._-linetype" "_l"  ltyp
(findfile 
(if (= (getvar "measurement") 0)
  "acad.lin"
  "acadiso.lin")) ""))
(princ)
  )
(defun C:ARL (/ *error* ang1 ang2 cent elist en end ltp p1 p2 pc sset start)
  (defun *error*  (msg)
    (if
      (vl-position
 msg
 '("console break"
   "Function cancelled"
   "quit / exit abort"
   )
 )
       (princ "Error!")
       (princ msg)
       )
    (if ltp (setvar "celtype" ltp))
    (command "._undo" "_e")
    (princ)
    )
  (command "._undo" "_be")
  (ltype-load "CENTER");<--change linetype to suit
  (setq ltp (getvar "celtype"))
  (setvar "celtype" "CENTER");<--change linetype to suit
  (if (setq sset (ssget "_:L" (list (cons 0 "ARC"))))
    (while 
  (setq en (ssname sset 0))
  (setq elist (entget en)
 cent (cdr (assoc 10 elist)))
(setq start (vlax-curve-getstartpoint en)
      end (vlax-curve-getendpoint en)
      )
(command "._line" "_non" cent "_non" start ""
  "._line" "_non" cent "_non" end ""
  )
  (setq ang1 (+ (angle cent start)(/ pi 2))
 p1 (polar start ang1 1)
 ang2 (- (angle cent end)(/ pi 2))
 p2 (polar end ang2 1)
 pc (inters start p1 end p2 nil)
 )
(command "._line" "_non" start "_non" pc ""
  "._line" "_non" end "_non" pc ""
  )
  (ssdel en sset)
)
    )
 (*error* nil)
  (princ)
  )
(princ "\n   *** Type ARL to execute   ***")
(prin1)
(vl-load-com)

~'J'~

[hofcad]

is it possible to do so.

could anyone write for me???

find the attached picture for more information.

(defun c:ALS(/ @ltype-load ~OSM ~CMD ~LTP etype ed MP R Ang1 Ang2)
(defun @ltype-load (ltyp)
(if (not (tblsearch "LTYPE" ltyp))
(command "._-LINETYPE" "_L" Ltyp
(findfile 
(if (= (getvar "MEASUREMENT") 0)
"Acad.lin" "Acadiso.lin")) ""))
)
(setq ~OSM (getvar "OSMODE") ~CMD (getvar "CMDECHO") ~LTP (getvar "CELTYPE") etype "")
(setvar "OSMODE" 0)(setvar "CMDECHO" 0)
(ltype-load "CENTER");<--change linetype to suit
(setvar "CELTYPE" "CENTER");<--change linetype to suit
(while (not (= etype "ARC"))
(setq ed (entget (car (entsel))))
(setq etype (cdr (assoc 0 ed)))
)
(setq MP (cdr (assoc 10 ed)) R (cdr (assoc 40 ed)) Ang1 (cdr (assoc 50 ed)) Ang2 (cdr (assoc 51 ed)))
(command "_.LINE" MP (polar MP Ang1 R) 
(polar MP (+ Ang1 (/ (- Ang2 Ang1) 2.0)) (abs (/ R (cos (/ (- Ang2 Ang1) 2.0))))) "")
(command "_.LINE" MP (polar MP Ang2 R) 
(polar MP (+ Ang1 (/ (- Ang2 Ang1) 2.0)) (abs (/ R (cos (/ (- Ang2 Ang1) 2.0))))) "")
(setvar "CELTYPE" ~LTP)(setvar "OSMODE" ~OSM)(setvar "CMDECHO" ~CMD)
(princ)
)
(princ "\n   *** Type ALS to execute   ***")

(defun c:MALS(/ @ltype-load ~OSM ~CMD ~LTP sset i ed MP R Ang1 Ang2)
(defun @ltype-load (ltyp)
(if (not (tblsearch "LTYPE" ltyp))
(command "._-LINETYPE" "_L" Ltyp
(findfile 
(if (= (getvar "MEASUREMENT") 0)
"Acad.lin" "Acadiso.lin")) ""))
)
(setq ~OSM (getvar "OSMODE") ~CMD (getvar "CMDECHO") ~LTP (getvar "CELTYPE") etype "")
(setvar "OSMODE" 0)(setvar "CMDECHO" 0)
(ltype-load "CENTER");<--change linetype to suit
(setvar "CELTYPE" "CENTER");<--change linetype to suit
(setq i 0 sset (ssget (list (cons 0 "ARC"))))
(repeat (sslength sset) 
(setq ed (entget (ssname sset i)))
(setq MP (cdr (assoc 10 ed)) R (cdr (assoc 40 ed)) Ang1 (cdr (assoc 50 ed)) Ang2 (cdr (assoc 51 ed)))
(command "_.LINE" MP (polar MP Ang1 R) 
(polar MP (+ Ang1 (/ (- Ang2 Ang1) 2.0)) (abs (/ R (cos (/ (- Ang2 Ang1) 2.0))))) "")
(command "_.LINE" MP (polar MP Ang2 R) 
(polar MP (+ Ang1 (/ (- Ang2 Ang1) 2.0)) (abs (/ R (cos (/ (- Ang2 Ang1) 2.0))))) "")
(setq i (1+ i))
)
(setvar "CELTYPE" ~LTP)(setvar "OSMODE" ~OSM)(setvar "CMDECHO" ~CMD)
(princ)
)
(princ "\n   *** Type MALS to execute   ***")

Regards, HofCAD CSI.

[Bruno.Valsecchi]

is it possible to do this for mutiple arcs at a single time?

My way ! for arcs and poly-arc

(vl-load-com)
(defun c:Draw_PolyArc ( / js n ename obj pr typ_obj pt_start pt_end pt_cen rad alpha pt_vtx dist_start dist_end seg_len seg_bulge)
 (defun grdraw-id_arc ( / )
  (grdraw (trans pt_start 0 1) (trans pt_vtx 0 1) 1)
  (grdraw (trans pt_vtx 0 1) (trans pt_end 0 1) 1)
  (grdraw (trans pt_start 0 1) (trans pt_cen 0 1) 3)
  (grdraw (trans pt_cen 0 1) (trans pt_end 0 1) 3)
 )
 (princ "\nSelect Arcs/PolyArcs .")
 (setq
  js
   (ssget
    '((-4 . "<OR")
     (-4 . "<AND")
      (0 . "POLYLINE")
      (-4 . "<NOT")
       (-4 . "&") (70 . 126)
      (-4 . "NOT>")
     (-4 . "AND>")
     (0 . "LWPOLYLINE,ARC")
    (-4 . "OR>"))
   )
  n -1
 )
 (cond
  (js
   (repeat (sslength js)
    (setq
     ename (ssname js (setq n (1+ n)))
     obj (vlax-ename->vla-object ename)
     pr -1
    )
    (setq typ_obj (vla-get-ObjectName obj))
    (if (eq typ_obj "AcDbArc")
     (progn
      (setq
       pt_start (vlax-get obj 'StartPoint)
       pt_end (vlax-get obj 'EndPoint)
       pt_cen (vlax-get obj 'Center)
       rad (vlax-get obj 'Radius)
       alpha (* (vlax-get obj 'TotalAngle) 0.5)
       pt_vtx (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
      )
      (grdraw-id_arc)
     )
     (repeat (fix (vlax-curve-getEndParam obj))
      (setq
       dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
       dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
       pt_start  (vlax-curve-GetPointAtParam obj pr)
       pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
       seg_len (- dist_end dist_start)
       seg_bulge (vla-GetBulge obj pr)
      )
      (if (not (zerop seg_bulge))
       (progn
        (setq
         rad (/ seg_len (* 4.0 (atan seg_bulge)))
         alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
         pt_cen (polar pt_start alpha rad)
         pt_vtx (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
        )
        (grdraw-id_arc)
       )
      )
     )
    )
   )
  )
 )
 (prin1)
)

[vnk17200414]

Thanks for your replies