Copy objects with base point and paste to polyline vertex

[notview]

I'm copying objects with text specify the base point and that base point will be used as second point of paste to Polyline Vertex. Having a 500 polyline vertex, it takes 500 times paste. Instead, anybody could help making lisp routine by select the polyline objects the copied objects (e.g.: circle, polygon, polyline, text,

ellipse) paste at once on the polyline vertexes.

 

Thank you!

[Tharwat]

Can you upload a sample drawing showing before and after of the routine ?

[notview]

yes, this is the sample..

[Tharwat]

Try this quick codes ...

 

(defun c:Test (/ *error* ss s p i e cm)
 (defun *error* (x)
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n*Cancel*")
 )
 (if (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
          (setq s (ssget "_:L"))
          (setq p (getpoint "\n Specify base point :"))
     )
   (progn (setq cm (getvar 'cmdecho))
          (setvar 'cmdecho 0)
          (command "_._copybase" "_non" p s "")
          (repeat (setq i (sslength ss))
            (setq e (entget (ssname ss (setq i (1- i)))))
            (foreach pt e
              (if (eq (car pt) 10)
                (command "_.pasteclip" (cdr pt))
              )
            )
          )
          (setvar 'cmdecho cm)
   )
 )
 (princ)
)

[notview]

Something wrong.. after I select the base point, all objects having vertex automatically paste by the objects I copied, without selecting first the polyline where I supposed to paste the Objects copied.

[Tharwat]

Something wrong.. after I select the base point, all objects having vertex automatically paste by the objects I copied, without selecting first the polyline where I supposed to paste the Objects copied.

 

If you want just to select specific polylines , just remove the "_X" from the code as shown in the following code .

 

(setq ss (ssget [color=blue][b]"_X"[/b][/color] '((0 . "LWPOLYLINE"))))

[troggarf]

Found at the swamp by Alan JT

http://www.theswamp.org/index.php?topic=35033.msg402543#msg402543

 

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

 (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 (i / ss e l)
                       (if (setq ss (ssget "_:L"))
                         (while (setq e (ssname ss (setq i (1+ i))))
                           (setq l (cons (vlax-ename->vla-object e) 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)
)

[notview]

I try to removed "_X" but still not working. I try lisp given by troggarf, it's working good!!

Thank you Tharwat and troggarf!!:)and also to Alan J. Thompson!

[Tharwat]

The codes work here , and I think it did not work for you due to the command copybase and pasteclip and my routine is very simple and nothings special .

[Enoc2013]

DOES IT WORK ON AUTOCAD 2013??

 

I am not at all familiar with the codes you all discuseed Iam sorry