Code: Select all
;;; Created for: http://www.bricsys.com/common/support/forumthread.jsp?id=26089
;;; Author: Roy Klein Gebbinck (www.b-k-g.nl) - this draws 2 temporary lines that stay if current layer is locked.
;;; Modified: Marko Ribar (AutoCAD implementation)
;;; Continue arc off of arc, zero (east) of circle line, pline & 2d, ends of partial true ellipse, 1st pt of true ellipse.
(defun c:A2 ( / cmde deriv dist lst obj pt el)
(vl-load-com)
(if
(and
(setq lst (entsel))
(setq obj (vlax-ename->vla-object (car lst)))
(or
(vl-position
(vla-get-objectname obj)
'("AcDb2dPolyline" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline" "AcDbSpline")
)
(prompt "\nError: invalid object \n")
)
(or
(equal (vlax-get obj 'normal) (trans '(0.0 0.0 1.0) 1 0 T) 1e-8)
(prompt "\nError: object not co-planar with current UCS \n")
)
)
(progn
(setq dist (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj (trans (cadr lst) 1 0))))
(if (< dist (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) dist))
(progn ; Closer to the start point.
(setq pt (vlax-curve-getstartpoint obj))
(setq deriv (mapcar '- (vlax-curve-getfirstderiv obj (vlax-curve-getstartparam obj))))
)
(progn
(setq pt (vlax-curve-getendpoint obj))
(setq deriv (vlax-curve-getfirstderiv obj (vlax-curve-getendparam obj)))
)
)
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq el (entlast))
(vl-cmdf "_.LINE" "_non" (trans pt 0 1) "_non" (trans (mapcar '- pt deriv) 0 1) "_non" (trans pt 0 1) "")
(while (setq el (entnext el))
(entdel el)
)
(vl-cmdf
"_.arc"
""
)
(while (> (getvar 'cmdactive) 0)
(vl-cmdf "\\")
)
(setvar 'cmdecho cmde)
)
)
(princ)
)