(defun c:CTV (/ foo ss lst pt)
;; Copy object(s) to vertices of selected curves (Arc, Line, *Polyline, Spline)
;; Alan J. Thompson, 09.24.10

(vl-load-com)

(defun foo (p)
(if (vl-consp p)
(or (vl-member-if
(function (lambda (a) (equal (list (car a) (cadr a)) (list (car p) (cadr p)))))
plst
)
((lambda (pnt) (foreach x lst (vla-move (vla-copy x) pt pnt)) (setq pLst (cons p pLst)))
(vlax-3d-point p)
)
)
)
)

(if (and (princ "\nSelect object(s) to copy: ")
(setq lst ((lambda (ss i / e l)
(if ss
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)
)
(ssget "_:L")
-1
)
)
(setq pt ((lambda (p) (cond (p (vlax-3d-point (trans p 1 0)))))
(getpoint "\nSpecify base point: ")
)
)
(princ "\nSelect curves to copy object(s) along: ")
(setq ss (ssget '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
)
((lambda (i / e eLst p pLst)
(while (setq e (ssname ss (setq i (1+ i))))
(cond
((vl-position (cdr (assoc 0 (setq eLst (entget e)))) '("ARC" "LINE" "SPLINE"))
(mapcar (function foo) (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
)
((vl-position (cdr (assoc 0 eLst)) '("LWPOLYLINE" "POLYLINE"))
(repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
(foo (vlax-curve-getPointAtParam e (setq p (1- p))))
)
)
)
)
)
-1
)
)
(princ)
)
(c:ctv)

Advertisements