aligning blocks along a pline

December 1, 2008

i am looking for routine to place a block on pline with uneven distance for example :

1st 200,

2nd 150' from the 1st point

3rd 300' etc

thx for any help

December 1, 2008

You might try a combination of these two lisps, but it won't align the block with the line...

Measureplinepnts will create an autocad point at the specified distance(s). Then you can replace said points with a block using replacepoints, but as I said it doesn't align them with the line.

MeasurePlinePts.lsp

replacepoints.lsp

December 1, 2008

try this.....:-)

;;;WIZMAN 01DEC08
(vl-load-com)
(defun c:balign	(/ bal_blk bal_blk_ent bal_dist bal_ent bal_ent_sp bal_tot_dist)
   (if
(and
    (not
	(while
	    (not
		(and
		    (or
			(setq
			    bal_ent (entsel "\n>>>...Pick Polyline, Line or Spline...<<<")
			) ;_ end_setq
			(princ "\n>>>...Missed, Try again...<<<")
		    ) ;_ end_or
		    (if	bal_ent
			(or
			    (member (cdr (assoc 0 (entget (car bal_ent))))
				    '("LWPOLYLINE" "SPLINE" "LINE")
			    ) ;_ end_member
			    (not
				(princ "\n>>>...Object is not a Line, Polyline, Spline...<<<"
				) ;_ end_princ
			    ) ;_ end_not
			) ;_ end_or
		    ) ;_ end_if
		) ;_ end_and
	    ) ;_ end_not
	) ;_ end_while
    ) ;_ end_not
    (not
	(while
	    (not
		(and
		    (or
			(setq bal_blk_ent (entsel "\n>>>...Pick Block...<<<"))
			(princ "\n>>>...Missed, Try again...<<<")
		    ) ;_ end_or
		    (if	bal_blk_ent
			(or
			    (member (cdr (assoc 0 (entget (car bal_blk_ent))))
				    '("INSERT")
			    ) ;_ end_member
			    (not
				(princ "\n>>>...Object is not a Block...<<<"
				) ;_ end_princ
			    ) ;_ end_not
			) ;_ end_or
		    ) ;_ end_if
		) ;_ end_and
	    ) ;_ end_not
	) ;_ end_while
    ) ;_ end_not
    (setq bal_blk (cdr (assoc 2 (entget (car bal_blk_ent)))))
) ;_ end_and
   (progn
       (setq bal_ent_sp (vlax-curve-getstartpoint (car bal_ent)))
       (setq bal_tot_dist '(+))
       (while (setq bal_dist (getreal "\n>>>...Enter Distance...>>>: "))
	   (if (<= (eval (setq bal_tot_dist (append bal_tot_dist (list bal_dist))))
		   (vlax-curve-getdistatparam
		       (car bal_ent)
		       (vlax-curve-getendparam (car bal_ent))
		   ) ;_ end_vlax-curve-getdistatparam
	       ) ;_ end_<=
	       (entmake
		   (list (cons 0 "INSERT")
			 (cons 2 bal_blk)
			 (cons 10
			       (vlax-curve-getpointatdist
				   (car bal_ent)
				   (eval bal_tot_dist)
			       ) ;_ end_vlax-curve-getpointatdist
			 ) ;_ end_cons
			 (cons 41 1)
			 (cons 42 1)
			 (cons 43 1)
			 (cons 50
			       (angle '(0 0)
				      (vlax-curve-getFirstDeriv
					  (car bal_ent)
					  (vlax-curve-getParamAtPoint
					      (car bal_ent)
					      (vlax-curve-getpointatdist
						  (car bal_ent)
						  (eval bal_tot_dist)
					      ) ;_ end_vlax-curve-getpointatdist
					  ) ;_ end_vlax-curve-getParamAtPoint
				      ) ;_ end_vlax-curve-getFirstDeriv
			       ) ;_ end_angle
			 ) ;_ end_cons
		   ) ;_ end_list
	       ) ;_ end_entmake
	       (progn (princ "\n>>>...Distance exceeds Length of Polyline...<<<\n") (exit))
	   ) ;_ end_if
       ) ;_ end_while
   ) ;_ end_progn
   ) ;_ end_if
   (princ)
) ;_ end_defun
(prompt "\n>>>...Balign.lsp is now loaded, Type 'Balign' to run command...<<<")
(princ)

December 2, 2008

Haha, great LISP - loving the use of:

    (if
       (and
    (not
	(while
	    (not
		(and
		    (or

December 2, 2008

Because wizman did not allow the user to exit the WHILE loops the code could be reduced to this:

;;;WIZMAN 01DEC08
;;  mod by CAB
(vl-load-com)
(defun c:balign (/ bal_blk bal_blk_ent bal_dist bal_ent bal_ent_sp bal_tot_dist)
 (while  ; will only exit on nil
   (not
     (and ; will return T only if user picks & is a member
       (or
         (setq bal_ent (entsel "\n>>>...Pick Polyline, Line or Spline...<<<"))
         (prompt "\n>>>...Missed, Try again...<<<") ; returns nil
       )
       (or
         (member (cdr (assoc 0 (entget (car bal_ent)))) '("LWPOLYLINE" "SPLINE" "LINE"))
         (prompt "\n>>>...Object is not a Line, Polyline, Spline...<<<") ; returns nil
       ) ;_ end_or
     ) ;_ end_and
   ) ;_ end_not
 ) ;_ end_while
 (while
   (not
     (and
       (or
         (setq bal_blk_ent (entsel "\n>>>...Pick Block...<<<"))
         (prompt "\n>>>...Missed, Try again...<<<")
       ) ;_ end_or
       (or
         (member (cdr (assoc 0 (entget (car bal_blk_ent)))) '("INSERT"))
         (prompt "\n>>>...Object is not a Block...<<<")
       ) ;_ end_or
     ) ;_ end_and
   ) ;_ end_not
 ) ;_ end_while

 (setq bal_blk (cdr (assoc 2 (entget (car bal_blk_ent)))))
 (setq bal_ent_sp (vlax-curve-getstartpoint (car bal_ent)))
 (setq bal_tot_dist '(+))
 (while (setq bal_dist (getdist "\n>>>...Enter Distance...>>>: "))
   (if (<= (eval (setq bal_tot_dist (append bal_tot_dist (list bal_dist))))
           (vlax-curve-getdistatparam
             (car bal_ent)
             (vlax-curve-getendparam (car bal_ent))
           ) ;_ end_vlax-curve-getdistatparam
       ) ;_ end_<=
     (entmake
       (list (cons 0 "INSERT")
             (cons 2 bal_blk)
             (cons 10
                   (vlax-curve-getpointatdist (car bal_ent) (eval bal_tot_dist)) 
             ) ;_ end_cons
             (cons 41 1)
             (cons 42 1)
             (cons 43 1)
             (cons 50
                   (angle '(0 0)
                          (vlax-curve-getFirstDeriv
                            (car bal_ent)
                            (vlax-curve-getParamAtPoint
                              (car bal_ent)
                              (vlax-curve-getpointatdist
                                (car bal_ent)
                                (eval bal_tot_dist)
                              ) ;_ end_vlax-curve-getpointatdist
                            ) ;_ end_vlax-curve-getParamAtPoint
                          ) ;_ end_vlax-curve-getFirstDeriv
                   ) ;_ end_angle
             ) ;_ end_cons
       ) ;_ end_list
     ) ;_ end_entmake
     (progn (princ "\n>>>...Distance exceeds Length of Polyline...<<<\n") (exit))
   ) ;_ end_if
 ) ;_ end_while
 (princ)
) ;_ end_defun
(prompt "\n>>>...Balign.lsp is now loaded, Type 'Balign' to run command...<<<")
(princ)

The only way to exit is via ESCape

December 2, 2008

thanks alan, im working on that but did not have time to finish because i went to watch the biggest fireworks in the world here in uae.. , here's a work in progress, your suggestions/improvements are worth alot:

;;;WIZMAN 01DEC08
(vl-load-com)
(defun c:balign	(/ bal_blk bal_blk_ent bal_dist bal_ent bal_ent_sp bal_tot_dist *error*)
   (defun *error* (msg)
(and bal_ent (not (redraw (car bal_ent) 4)))
(and bal_blk_ent (not (redraw (car bal_blk_ent) 4)))
   ) ;_ end_defun
   (setvar 'errno 0)
   (if
(and
    (not
	(while
	    (not
		(and
		    (or
			(setq
			    bal_ent
			       (entsel "\n>>>...Pick Polyline, Line or Spline...<<<"
			       ) ;_ end_entsel
			) ;_ end_setq
			(if (= (getvar "errno") 52)
			    (exit)
			    nil
			) ;_ end_if
			(not
			    (and
				(princ "\n>>>...Missed, Try again...<<<")
				(setvar 'errno 0)
			    ) ;_ end_and
			) ;_ end_not
		    ) ;_ end_or
		    (if	bal_ent
			(or
			    (member (cdr (assoc 0 (entget (car bal_ent))))
				    '("LWPOLYLINE" "SPLINE" "LINE")
			    ) ;_ end_member
			    (not
				(princ "\n>>>...Object is not a Line, Polyline, Spline...<<<"
				) ;_ end_princ
			    ) ;_ end_not
			) ;_ end_or
		    ) ;_ end_if
		) ;_ end_and
	    ) ;_ end_not
	) ;_ end_while
    ) ;_ end_not
    (not (redraw (car bal_ent) 3))
    (not
	(while
	    (not
		(and
		    (or
			(setq
			    bal_blk_ent
			       (entsel "\n>>>...Pick Block...<<<"
			       ) ;_ end_entsel
			) ;_ end_setq
			(if (= (getvar "errno") 52)
			    (exit)
			    nil
			) ;_ end_if
			(not
			    (and
				(princ "\n>>>...Missed, Try again...<<<")
				(setvar 'errno 0)
			    ) ;_ end_and
			) ;_ end_not
		    ) ;_ end_or
		    (if	bal_ent
			(or
			    (member (cdr (assoc 0 (entget (car bal_blk_ent))))
				    '("INSERT")
			    ) ;_ end_member
			    (not
				(princ "\n>>>...Object is not a Block...<<<"
				) ;_ end_princ
			    ) ;_ end_not
			) ;_ end_or
		    ) ;_ end_if
		) ;_ end_and
	    ) ;_ end_not
	) ;_ end_while
    ) ;_ end_not
    (setq bal_blk (cdr (assoc 2 (entget (car bal_blk_ent)))))
    (not (redraw (car bal_blk_ent) 3))
) ;_ end_and
   (progn
       (setq bal_ent_sp (vlax-curve-getstartpoint (car bal_ent)))
       (setq bal_tot_dist '(+))
       (while (progn
		  (if (null bal_dist)
				;(if (not (zerop bal_dist))
		      (setq bal_dist 0.0)
				;	      ) ;_ end_if
		  ) ;_ end_if
		  (initget 6)
		  (setq	bal_temp (getreal (strcat "\n>>>...Enter Distance..."
						  "<"
						  (rtos bal_dist 2 2)
						  ">: "
					  ) ;_ end_strcat
				 ) ;_ end_getreal
		  ) ;_ end_setq

		  (if bal_temp
		      (setq bal_dist bal_temp)
		      (setq bal_temp bal_dist)
		  ) ;_ end_if
	      ) ;_ end_progn

	   (if (<= (eval (setq bal_tot_dist (append bal_tot_dist (list bal_dist))))
		   (vlax-curve-getdistatparam
		       (car bal_ent)
		       (vlax-curve-getendparam (car bal_ent))
		   ) ;_ end_vlax-curve-getdistatparam
	       ) ;_ end_<=
	       (entmake
		   (list (cons 0 "INSERT")
			 (cons 2 bal_blk)
			 (cons 10
			       (vlax-curve-getpointatdist
				   (car bal_ent)
				   (eval bal_tot_dist)
			       ) ;_ end_vlax-curve-getpointatdist
			 ) ;_ end_cons
			 (cons 41 1)
			 (cons 42 1)
			 (cons 43 1)
			 (cons 50
			       (angle '(0 0)
				      (vlax-curve-getFirstDeriv
					  (car bal_ent)
					  (vlax-curve-getParamAtPoint
					      (car bal_ent)
					      (vlax-curve-getpointatdist
						  (car bal_ent)
						  (eval bal_tot_dist)
					      ) ;_ end_vlax-curve-getpointatdist
					  ) ;_ end_vlax-curve-getParamAtPoint
				      ) ;_ end_vlax-curve-getFirstDeriv
			       ) ;_ end_angle
			 ) ;_ end_cons
		   ) ;_ end_list
	       ) ;_ end_entmake
	       (progn (princ "\n>>>...Distance exceeds Length of Polyline...<<<\n") (exit))
	   ) ;_ end_if
       ) ;_ end_while
   ) ;_ end_progn
   ) ;_ end_if
   (*error* nil)
   (princ)
) ;_ end_defun
(prompt "\n>>>...Balign.lsp is now loaded, Type 'Balign' to run command...<<<")
(princ)

December 2, 2008

this is perfect thx a lot

Sign In

aligning blocks along a pline

Recommended Posts

kapsel

rustysilo

wizman

Lee Mac

CAB

wizman

kapsel

Join the conversation

Tutorials

Forums

Activity