(defun c:LA (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
;; Draw quick leader arrow
;; Alan J. Thompson, 03.13.11
;; Slightly modified by Igal Averbuh 2017 (added option to Specify Arrow Head Size)
(vl-load-com)

(setvar 'DIMASZ
(cond ((getdist (strcat "\nSpecify Arrow Head Size : ")))
((getvar 'DIMASZ))
)
)

(defun _group (l)
(if (caddr l)
(cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
)
)

(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

(setq lastentity (entlast))
(if (and (setq p1 (getpoint "\nSpecify first point: "))
(setq p2 (getpoint p1 "\nSpecity next point: "))
(vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
(not (equal lastentity (setq ent (entlast))))
(setq obj (vlax-ename->vla-object ent))
)
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(grdraw (cadr gr)
(trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
3
-1
)
(if
(equal
(last (setq coords (_group (vlax-get obj 'Coordinates))))
(car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
)
(vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
)
(grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
)
)
(redraw)
(princ)
)
(c:la)

Advertisements