Jump to content

Divide Objects with equal spacing between each object along line or curve


3dwannab

Recommended Posts

Hi.

 

I've looked high and low for a program like this.

 

What I'd like to achieve.

 

Pick a Line or Curve.

Pick object (mostly squares, rectangles or circles)

Pick distance or enter a width of object selected object.

Program then divides the object on the line or curve like the image attached.

 

Here's a program I think is close. It's from LeeMac but not sure how to edit it to suit the above needs.

 

(defun c:test ( / _circle p1 p2 no di an sp i ucsz )

 (defun _circle ( center radius )
   (entmakex (list (cons 0 "CIRCLE") (cons 10 center) (cons 40 radius) (cons 210 ucsz)))
 )
 (setq ucsz (trans '(0. 0. 1.) 1 0 t))

 (if
   (and
     (setq p1 (getpoint "\nSpecify First Point: "))
     (setq p2 (getpoint "\nSpecify Second Point: " p1))
     (progn
       (initget 6)
       (setq no (getint "\nSpecify Number of Circles: "))
     )
     (setq di (getdist "\nSpecify Diameter of Circles: "))
   )
   (progn
     (setq p1 (trans p1 1 ucsz) p2 (trans p2 1 ucsz)
           an (angle p1 p2)     di (/ di 2.)
           p1 (polar p1 an di)  p2 (polar p2 an (- di))
     )
     (if (= 1 no)
       (setq sp (/ (distance p1 p2) 2.) i 0)
       (setq sp (/ (distance p1 p2) (1- no)) i -1)
     )      
     (repeat no (_circle (polar p1 an (* (setq i (1+ i)) sp)) di))
   )
 )
 (princ)

 

Thanks in advance.

Divide Line, Polyline with user inputed circle diameter with eq spacing.jpg

Link to comment
Share on other sites

Thanks. I came across that in my searches.

 

Nothing is happening.

 

  1. I select the object.
  2. Pick Distance.
  3. Nothing is arrayed.

 

Using ACAD 2017. Updated my info there now.

Link to comment
Share on other sites

Here you will find tool that I'm using

 

Thanks. For the life of me I couldn't get that to work. Could you be so kind as to how you achieve the spacings I'm after?

Link to comment
Share on other sites

What about:

  • ssget '((0 . "CIRCLE,LINE"))
  • find the line's ename, and construct list of the circles
  • invoke the intersectwith method and construct a point list
  • offset the line, and project the pointlist

or something like that..

Link to comment
Share on other sites

What about:

  • ssget '((0 . "CIRCLE,LINE"))
  • find the line's ename, and construct list of the circles
  • invoke the intersectwith method and construct a point list
  • offset the line, and project the pointlist

or something like that..

I'd love nothing more than to have the skill to do that. Although it's not exactly what I'm after.

Link to comment
Share on other sites

Nothing is happening.

 

 

  1. I select the object.
  2. Pick Distance.
  3. Nothing is arrayed.

 

Note that all copies/objects to be spaced should already exist - the program will then position them equidistant from each other.

Link to comment
Share on other sites

Note that all copies/objects to be spaced should already exist - the program will then position them equidistant from each other.

 

I see, silly me. See attached the problem. This seems to be a good solution. Quick and easy, just the spacings are a little wacky once I choose the pick the end point.

 

If this could divide them like the first post it would be a huge time saver.

before.jpg

after.jpg

Link to comment
Share on other sites

  • 2 weeks later...
Reminds me of Alan JT's spacing routine.

Aside I remember some routine like (defun C:spb ...) but can't seem to find it. I think the author was.. you? and it achieves the same grread result as Alan's.

 

Back to this again. I've found that Routine here & here.

 

I've modified it so that it asks the user to input or pick the width of the object and then it divides accordingly. Well, it doesn't use the first object and last object in the divide as you can see in the before and after pics attached.

 

But, I'm glad I could manage to get it to work somehow. Works in UCS too.

 

If someone could help modify it so that it could use & divide the start and end object along the line then that would be great like the CORRECT RESULT image.

 

My modified version:

;; Code found:
;; https://www.theswamp.org/index.php?topic=51616.msg566915#msg566915
;; https://www.theswamp.org/index.php?topic=51564.msg566732#msg566732
;;
;; Modified by 3dwannab on 11.04.17
;; Made it work by adding prompt to enter/pick width of arrayed objects and result will divide with equal spacings between object boundaries.
;;
;; Known Bugs: Doesn't use the start and end object of the arrayed objects.
;;
(defun _bboxandmid (obj / a b l)
(vla-getboundingbox obj 'a 'b)
(list (car (setq l (mapcar 'vlax-safearray->list (list a b))))
	; (apply '(lambda (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b)) l)
	(apply '(lambda (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b)) l)
	(cadr l)
	)
)
(defun ss->lst (ss / i l)
(if (eq (type ss) 'pickset)
	(repeat (setq i (sslength ss))
		(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
		)
	)
)
(defun c:spb (/ di doc fac g lst p1 p2 vec)
;; Added by 3dwannab.
(setq di (getdist "\nEnter or Pick width of Array Object: "))
(if di
;;
(progn
	(setq di (/ di 2.))
	(if
		(and
			(setq lst (ss->lst (ssget "_:L")))
			(or
				(< 1 (length lst))
				(prompt "\nSelection set must contain at least 2 entities ")
				)
			(or
				(setq fixDist (getdist "\nFixed distance or Enter: "))
				T
				)
			(setq p1 (getpoint "\nSpecify first point: "))
			)
		(progn
			(setq doc (vla-get-activedocument (vlax-get-acad-object)))
			(vla-endundomark doc)
			(vla-startundomark doc)
			(princ "\nSpecify second point: ")
			(while (eq 5 (car (setq g (grread t 15 0))))
				(redraw)
				(setq p2 (cadr g))
				(setq p2
					(cond
					((osnap p2 "_END,_MID")) ; Change to suit your needs.
					(p2)
					)
					)
				(if (not (equal p1 p2 1e-4))
					(progn
						(grdraw p1 p2 1 -1)
						(setq fac
							(cond
							; (fixDist (/ (distance p1 p2) fixDist))
							;; Added by 3dwannab.
							(fixDist (/ (distance (list (- (car p1) di) (cadr p1) (caddr p1)) (list (+ (car p2) di) (cadr p2) (caddr p2))) fixDist))
							;;
							((1- (length lst)))
							)
							)
					; (setq vec (trans (mapcar '(lambda (crd1 crd2) (/ (- crd2 crd1) fac)) p1 p2) 1 0 T))
					;; Added by 3dwannab.
					(setq vec (trans (mapcar '(lambda (crd1 crd2) (/ (- crd2 crd1) fac)) (list (- (car p1) di) (cadr p1) (caddr p1)) (list (+ (car p2) di) (cadr p2) (caddr p2))) 1 0 T))
					;;
					;; Added by 3dwannab.
					(vlax-invoke (car lst) 'move (cadr (_bboxandmid (car lst))) (trans (list (- (car p1) di) (cadr p1) (caddr p1)) 1 0))
					;;
					; (vlax-invoke (car lst) 'move (cadr (_bboxandmid (car lst))) (trans p1 1 0))
					(mapcar
						'(lambda (o1 o2 / l)
							(vlax-invoke o2 'move (cadr (_bboxandmid o2)) (mapcar '+ (cadr (_bboxandmid o1)) vec))
							)
						lst
						(cdr lst)
						)
					)
					)
				)
			(vla-endundomark doc)
			)
		)
	)
)
(redraw)
(princ)
)

before.jpg

after.jpg

Correct Result.jpg

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...