Move block along polyline with it's base point

[Automohan]

Lisp to move block along polyline with it's base point & specify distance..........

[dlanorh]

Perhaps a sample drawing (AutoCAD 2010) with the block and polyline would help. It's impossible to code without knowing the block name and its basepoint and definition orientation. 

[Automohan]

After running the program it should ask for "select block" through the block it will identify the base point & 

it should ask for "select polyline" then this programme will be useful for many people.......

otherwise say block name is "Hump"

Path is always polyline only (no lines, arcs or circles)

thanks a lot

[dlanorh]

---

@Automohan wrote:

After running the program it should ask for "select block" through the block it will identify the base point & 

it should ask for "select polyline" then this programme will be useful for many people.......

otherwise say block name is "Hump"

Path is always polyline only (no lines, arcs or circles)

thanks a lot

---

That doesn't tell me the relationship of the base point in relation to the rest of the block, or how the orientation of the block needs to be altered as it moves along the polyline, and it tells me nothing about the relationship of the block to the polyline.

[Sea-Haven]

It is easy using VL lisp here is a chainage lisp that is a good starting point replace the add text  with insert your block.

Will see if I can find time.

[ВeekeeCZ · Accepted solution]

Hi, this could be enough to start.

I have many routines upon 'along path' subject like the one below -- I might do something more complex some time...

(vl-load-com)

(defun c:CopyAlongPolyline ( / en pl pt p1 p2 lst) ;Move Along Line
  (if (and (setq en (car (entsel "\nSelect object to copy: ")))
	   (setq pl (car (nentsel "\nSelect path: ")))
	   (wcmatch (cdr (assoc 0 (entget pl))) "*LINE,ARC,CIRCLE,RAY")
	   (wcmatch (cdr (assoc 0 (entget pl))) "~MLINE")
	   (setq p1 (trans (vlax-curve-getClosestPointTo pl (cdr (assoc 10 (entget en)))) 0 1)) ; p1 ucs
           (princ "\nSelect objects to define destinations (point/circles/blocks) <pick>: ")
           (or (and (setq lst (ssget '((0 . "POINT,INSERT,CIRCLE"))))
		    (setq lst  (mapcar '(lambda (e) (trans (cdr (assoc 10 (entget e))) 0 1))
				       (vl-remove-if 'listp (mapcar 'cadr (ssnamex lst))))))
	       (while (setq p2 (getpoint "\nDestination point: " p1))
		 (setq lst (cons (trans p2 1 0) lst)))
	       lst)
	   )
    (foreach p lst
      (command "_.COPY" en ""
	     "_none" p1 ; ucs
	     "_none" p

	     "_.MOVE" "_l" "" 
	     "_none" (setq pt (getvar 'LASTPOINT)) ; pt ucs
	     "_none" (setq p2 (trans (vlax-curve-getClosestPointTo pl (trans pt 1 0)) 0 1)) ; p2 ucs

	     "_.ROTATE" "_l" ""
	     "_none" p2
	     "_Reference"
	     '(0 0 0) ; wcs
	     (vlax-curve-getFirstDeriv pl (vlax-curve-getParamAtPoint pl (trans p1 1 0))) ; wcs
	     "_Points"
	     '(0 0 0) ; wcs
	     (vlax-curve-getFirstDeriv pl (vlax-curve-getParamAtPoint pl (trans p2 1 0))) ; wcs
	     )))
  (princ)
)

[Automohan]

Can you slightly modify the program according to my little more requirement.....

This is placing at pick point, add for specify distance also....

[Sea-Haven]

My version a bit simpler but only accepts plines. No error checks.

; Insert a block at a distance along a pline
; By Alan H July 2019

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)

(defun c:AHINS ( / obj dist pt oldang)
(setq oldang (getvar 'aunits))
(setvar 'aunits 3)
(setq obj (vlax-ename->vla-object (car (entsel "pick object"))))
(if (= (vla-get-entityname obj) "AcDbPolyline")
(progn
(setq dist (getreal "Enter distance"))
(setq bname (getstring "Enter blockname "))
(setq pt (vlax-curve-getpointatdist obj dist))
(setq ang (alg-ang obj pt))
(command "-insert" bname pt 1 1 ang)
)
(alert "You have not picked a pline")
)
(setvar 'aunits oldang)
(princ)
)
(c:ahins )