topic Move block along polyline with it's base point in Visual LISP, AutoLISP and General Customization Forum

Move block along polyline with it's base point

Automohan — Thu, 11 Jul 2019 12:31:12 GMT

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

Re: Move block along polyline with it's base point

dlanorh — Thu, 11 Jul 2019 12:44:52 GMT

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.

Re: Move block along polyline with it's base point

Automohan — Thu, 11 Jul 2019 12:57:45 GMT

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

Re: Move block along polyline with it's base point

dlanorh — Thu, 11 Jul 2019 17:16:00 GMT

@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.

Re: Move block along polyline with it's base point

Sea-Haven — Fri, 12 Jul 2019 04:23:54 GMT

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.

Re: Move block along polyline with it's base point

ВeekeeCZ — Fri, 12 Jul 2019 08:01:30 GMT

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)
)

Re: Move block along polyline with it's base point

Automohan — Fri, 12 Jul 2019 17:53:04 GMT

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

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

Re: Move block along polyline with it's base point

Sea-Haven — Sat, 13 Jul 2019 01:26:09 GMT

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 )