Insert block every 50' along multiple Polylines

Insert block every 50' along multiple Polylines

Jeffrey.e.straus
Observer Observer
682 Views
4 Replies
Message 1 of 5

Insert block every 50' along multiple Polylines

Jeffrey.e.straus
Observer
Observer

I have a drawing that has 350 polylines that need to have a block added every 50' aligned with the polyline.

I know how to use the measure command and to place a block along an individual polyline every 50'. what I am wondering is if there is a way to do that to all 350 of the polylines in one shot?

 

I am fairly new to AutoCAD and very new to trying to use it efficiently.

 

I tried to see if there was already a solution to this question somewhere but was unable to find one so I thought Id throw it out there.

Thanks in advance for the help!
-Jeff

0 Likes
683 Views
4 Replies
Replies (4)
Message 2 of 5

ВeekeeCZ
Consultant
Consultant

Probably posted before.

 

(defun c:MeasureM (/ s d b a i e)

  (if (and (setq s (ssget '((0 . "LWPOLYLINE,LINE,ARC,POLYLINE,CIRCLE,ELLIPSE,SPLINE""))))
	   (setq d (getdist "\nSpecify length of segment: "))
	   )
    (progn
      (and (progn
	     (setq b (getstring "\nBlock name or <use points>: "))
	     (/= b ""))
	   (not (initget "Yes No"))
	   (setq a (cond ((getkword "Align block with object? [Yes/No] : "))
			 ("Yes")))
	   )
      (repeat (setq i (sslength s))
	(setq e (ssname s (setq i (1- i))))
	(if a
	  (command "_.measure" e "_b" b a d)
	  (command "_.measure" e d)))))
  (princ)
  )

 

0 Likes
Message 3 of 5

Kent1Cooper
Consultant
Consultant

If it's going to allow path types other than the Polyline requested [Lines & Arcs], then it may as well also allow the other possibilities ["heavy" Polylines, Circles, Ellipses, Splines].

 

But something's not right....  If I am reading it correctly, it will quit if a Block name is not supplied, so there must always be a Block name.  That is appropriate to this topic, but was the code adapted from something that retained the Points option, so that the Block Alignment option would not be asked for if the Block name was an empty string?  As altered, it looks like it won't allow the Points option.   That, in combination with the fact that the 'a' variable will never be nil, means the (if) at the end is not needed -- it will always use the command version with the Blocks option.

Kent Cooper, AIA
Message 4 of 5

ВeekeeCZ
Consultant
Consultant

@Kent1Cooper wrote:

... But something's not right....  If I am reading it correctly, it will quit if a Block name is not supplied, so there must always be a Block name.  That is appropriate to this topic, but was the code adapted from something that retained the Points option, so that the Block Alignment option would not be asked for if the Block name was an empty string?  As altered, it looks like it won't allow the Points option.   That, in combination with the fact that the 'a' variable will never be nil, means the (if) at the end is not needed -- it will always use the command version with the Blocks option.


 

Code updated.

The site removed <use points> as a fake tag when pasted. Hopefully, it makes sense now. Thanks for the heads up.

0 Likes
Message 5 of 5

hak_vz
Advisor
Advisor

Inserts aligned blocks over selected lwpolylines .

 

(defun c:boply( / *error* getblocks select_block rad_to_deg adoc ss sel sc i j po dist arr_dis pt1 pt2 old_dia old_req);
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'attdia old_dia)
		(setvar 'attreq old_req)
		(setvar 'cmdecho 1)
		(if (and adoc) (vla-endundomark adoc))
		(princ)
	)
	(defun getblocks (/ adoc name lst sel)
	  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
	  (vlax-for blk (vla-get-blocks adoc)
		;; Exclude model and paper spaces, xref and anonymus blocks
		(if (and  (equal (vla-get-IsLayout blk) :vlax-false)
				  (equal (vla-get-IsXref blk) :vlax-false)
				  (/= (substr (vla-get-Name blk) 1 1) "*")) 
			 (setq lst (cons (vla-get-Name blk) lst))
		  ) 
		) 
	  lst
	)
	(defun select_block ( / ff f lst dcl_id sel)
		(setq 
			ff (vl-filename-mktemp "blocks.dcl")
			f (open ff "w")
			lst (getblocks)
		)
		(write-line "test: dialog {:row {:list_box {label = \"Select block\"; key = \"blocks\";fixed_width = true;width = 20;height = 12;multiple_select = false; } } ok_cancel; }" f)
		(close f)
		(setq dcl_id (load_dialog ff))
		(if (not (new_dialog "test" dcl_id)) (exit))
		(start_list "blocks" 3)
		(mapcar 'add_list lst)
		(end_list)
		(action_tile "accept" "(setq sel (get_tile \"blocks\"))(done_dialog)")
		(start_dialog)
		(done_dialog dcl_id)
		(unload_dialog dcl_id)
		(vl-file-delete ff)
		(cond 
			((and sel)
				(setq sel(nth (atoi sel) lst))
			)
		)
		sel
	)
	(defun rad_to_deg (rad)(* 180.0 (/ rad pi)))
	(princ "\nSelect polylines to place block >")
	(setq 
		adoc (vla-get-activedocument (vlax-get-acad-object))
		ss (ssget '((0 . "LWPOLYLINE")))
		sel(select_block)
		arr_dis (getreal "\nBlock distance > ")
		sc (getreal "\nBlock scale >")
		old_dia (getvar 'attdia)
		old_req (getvar 'attreq)
		j -1
	)
	(vla-endundomark adoc)
	(vla-startundomark adoc)
	(mapcar 'setvar '("cmdecho" "attdia" "attreq") '(0 0 1))
	(cond 
		((and ss sel)
			(while (< (setq j (1+ j))(sslength ss))
				(setq 
					po (vlax-ename->vla-object (ssname ss j))
					len(vlax-get po 'Length)
					i -1
				)
				(while (< (+ (setq dist(* (setq i (1+ i)) arr_dis)) 0.1) len )
					(setq 
						pt1 (vlax-curve-getPointAtDist po dist)
						pt2 (vlax-curve-getPointAtDist po (+ dist 0.1))
						ang (rad_to_deg(angle pt2  pt1 ))
					)
					(command "_.insert" sel "_none" pt1 sc sc ang) 
				)
			)
		)
	)
	(mapcar 'setvar '("cmdecho" "attdia" "attreq") '(1 1 0))
	(vla-endundomark adoc)
	(princ)
)

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.