AutoCAD LISP routine for 'copy-array-fit' with MAX spacing

[BigBoyCAD]

Hello.

Using AutoCAD 2025LT.

I am seeking a LISP routine for 'copy-array-fit' sequence that allows you to -

- select object to copy

- select copy basepoint

- select copy point 1

- select copy point 2

- designate maximum spacing between objects copied between point 1 and point 2.

I am struggling to write or find a LISP that works consistently.

Below is the closest I have come to a consistently working 'copy-array-fit' with MAX spacing routine:

(defun C:copy-array-fit-max-spacing ()
(setq PT1 nil PT2 nil OSN (getvar "osmode") LFAC (getvar "dimlfac"))
(princ "\nSelect objects to array: ")
(setq ENTOBJS (ssget))
(if ENTOBJS
(progn
(setq ENTOBJ (ssname ENTOBJS 0))
(if ENTOBJ (setq ENT (entget ENTOBJ)))
(setq PT1 (cdr (assoc 10 ENT)))
(setvar "osmode" 0)

;; Get second point
(while (not PT2)
(setq PT2 (getpoint PT1 "\nPick array end point: "))
)

;; Compute distance, angle, and spacing
(setq PTANG (angle PT1 PT2))
(setq SPACE (/ (getdist "\nEnter spacing: ") LFAC))
(setq PT-DIST (distance PT1 PT2))
(setq NUMTO (fix (/ PT-DIST SPACE)))

;; Ensure at least one object is copied
(if (= NUMTO 0)
(princ "\nSpacing too large for array.")
(progn
;; Compute exact spacing to ensure alignment
(setq SPACE (/ PT-DIST NUMTO))

;; Loop through and copy objects with exact placement
(setq i 1)
(while (<= i NUMTO)
(setq NEWPT (list (+ (car PT1) (* i SPACE (cos PTANG)))
(+ (cadr PT1) (* i SPACE (sin PTANG)))))
(command "copy" ENTOBJS "" PT1 NEWPT)
(setq i (1+ i))
)
)
)

(setvar "osmode" OSN)
(princ (strcat "\n" (itoa NUMTO) " objects arrayed with exact spacing: " (rtos SPACE 2 4)))
)
)
(princ)
)

Issues:

- Works sporadically 

- At times places objects spaced correctly, though places the 2nd object over the 1st object.

- At times places objects spaced correctly, though places the 2nd object over the 1st object and 2nd last object over the last object.

- Routine copies objects one less time that it should.

Any help would be much appreciated.

[Kent1Cooper]

.... never mind ....  Sounded like running Osnap was on, but I now see you control for that, unless maybe there's a parentheses imbalance or something.

[ВeekeeCZ]

Post a sample dwg.. with desired outcome.

[Moshe-A]

@BigBoyCAD  hi,

If you want the copy to be fix (equal spacing) instead of asking the spacing, ask for the number of copies (that's how the DIVIDE command works) and let the program calculate spacing cause it is likely that array distance does not divide exactly by spacing.

You can run the the COPY command once and use the multiple option and supply only new points instead of calling it multiple times and supply the first pt + second pt

(command "._copy" "_si" ENTOBJS "_Multiple")

;; Loop through and copy objects with exact placement
(setq i 1)
(while (<= i NUMTO)
  (setq NEWPT (list (+ (car PT1) (* i SPACE (cos PTANG)))  (+ (cadr PT1) (* i SPACE (sin PTANG)))))
  (command NEWPT)
  (setq i (1+ i))
)

(command "") ; finish copy command

 Moshe

[cadffm]

---

@Kent1Cooper  schrieb:

.... but I now see you control for that

---

It is not fully controled in this lispcode (I learned today, because of this post here).

@BigBoyCAD 

Instead of posting my guess, please edit your code and test.

Change (setvar "osmode" 0) to (setvar "osnapcoord" 1)

Delete (setvar "osmode" OSN)

Try to get wrong result now.

[cadffm]

---

@cadffm  schrieb:

---

@Kent1Cooper  schrieb:

.... but I now see you control for that

---

It is not fully controled in this lispcode (I learned today, because of this post here).

I'm backtracking, but not completely.

Explaination: During testing I had a very unusual situation, new to me.

Despite osmode=0, the END object snap was taken into account!

I have to explain that I checked the behavior with osnapcoord=0 as possible issue here (so ALWAYS take the continuous object snap into account).

Result of 30-40+ test runs: An object snap was used, although osmode = 0.

Only with osnapcoord=1 (which you should control and use sensibly) was it guaranteed that it would react as desired.

I could repeat it as often as I wanted, but apparently only in this file session.

So it doesn't show any general problematic behavior of osmode=0,

however, it still supports my approach of not using this method, even if it is only problematic in exceptional cases:

It is simply not necessary. It was a frightening experience, now I'm glad it's over LOL.

[BigBoyCAD]

Hi Beekee.

Attached is a .dwg showing the desired outcome I am seeking with the 'copy-array-fit-max spacing' LISP routine.

You will also see other outcomes from slightly different versions of LISP I have put together for this.

Thank you.

[BigBoyCAD]

Hi Moshe.

Thank you for your ideas.

I already have a macro that allows for copying objects with correct spacing once the correct number of objects has been determined.

i.e. a macro that runs the 'copy-array-fit' sequence.

Though I am specifically seeking a lisp routine that does not require me to determine how many objects must be copied.

Though rather, allows me to simply dial in the max spacing between objects.

None the less as I want to try all angles may I please ask if I have stitched your piece of code in correctly?

I am new to writing code and can't always see where something is not how it should be.

Any help on this would be greatly appreciated.

Please see following code: 

(defun C:FD2 ()
(setq PT1 nil PT2 nil OSN (getvar "osmode") LFAC (getvar "dimlfac"))
(princ "\nSelect objects to array: ")
(setq ENTOBJS (ssget))
(if ENTOBJS
(progn
(setq ENTOBJ (ssname ENTOBJS 0))
(if ENTOBJ (setq ENT (entget ENTOBJ)))
(setq PT1 (cdr (assoc 10 ENT)))
(setvar "osnapcoord" 1)

;; Get second point
(while (not PT2)
(setq PT2 (getpoint PT1 "\nPick array end point: "))
)

;; Compute distance, angle, and spacing
(setq PTANG (angle PT1 PT2))
(setq SPACE (/ (getdist "\nEnter spacing: ") LFAC))
(setq PT-DIST (distance PT1 PT2))
(setq NUMTO (fix (/ PT-DIST SPACE)))

;; Ensure at least one object is copied
(if (= NUMTO 0)
(princ "\nSpacing too large for array.")
(progn
;; Compute exact spacing to ensure alignment
(setq SPACE (/ PT-DIST NUMTO))

;; Loop through and copy objects with exact placement
(setq i 1)
(while (<= i NUMTO)
(setq NEWPT (list (+ (car PT1) (* i SPACE (cos PTANG))) (+ (cadr PT1) (* i SPACE (sin PTANG)))))
(command NEWPT)
(setq i (1+ i))
)
(command "._copy" "_si" ENTOBJS "_Multiple") ; finish copy command
(setq i (1+ i))
)
)
)

(princ (strcat "\n" (itoa NUMTO) " objects arrayed with exact spacing: " (rtos SPACE 2 4)))
)
)
(princ)
)

[Sea-Haven · Accepted solution]

Another sample code

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autocad-lisp-routine-for-copy-array-fit-with-max-spacing/td-p/13339849

(defun c:wow ( / pt1 pt2 ang maxd dist inc ent oldsnap howmanychk)

(setq pt1 (getpoint "\nPick point 1 "))
(setq pt2 (getpoint "\nPick point 2 "))

(setq ang (angle pt1 pt2))
(setq maxd (getreal "\nEnter max distance "))
(setq dist (distance pt1 pt2))
(setq howmanychk (/ dist maxd))
(if (< (- howmanychk (fix howmanychk)) 1e-8)
(setq howmany (fix howmanychk))
(setq howmany (+ (fix howmanychk) 1))
)
(setq inc (/ dist howmany))

(setq ent (car (entsel "\nPick object to copy ")))
(setq off 0.0)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(repeat howmany
  (command "copy" ent "" pt1 (polar pt1 ang (setq off (+ off inc))))
)

(setvar 'osmode oldsnap)
(princ)
)
(C:wow)

[BigBoyCAD]

Hi Sebastian.

Thank you very much for looking into this.

After making your suggested changes to the code I am pleased to say that, while it is still not working 100% successfully, the code is being very consistent.

Out of 35 tests designating different max spacing between objects.. 

- All tests copied the objects along correct desired alignment no matter angle/rotation was being used between copy point 1 and copy point 2. 

- The first 9 tests (max spacing 1000mm) worked 100% successfully even when using multiple different rotations/angles between copy points.

- All other tests using different maxing spacing copied object 1 less times than what was required.

- One of these tests using max spacing of 2000mm copied object 2 less times.

- A further 10 tests using this same spacing and rotation resulted in:    

    - 8 x objects being copied 2 less times than what was required.    

    - 2 x objects being copied 1 less times than what was required.

The code is almost there.

I have also attached a .dwg showing an example of the test runs I mentioned.

I have included the LISP code both below and within the .dwg 

(defun C:FD1 ()
(setq PT1 nil PT2 nil OSN (getvar "osmode") LFAC (getvar "dimlfac"))
(princ "\nSelect objects to array: ")
(setq ENTOBJS (ssget))
(if ENTOBJS
(progn
(setq ENTOBJ (ssname ENTOBJS 0))
(if ENTOBJ (setq ENT (entget ENTOBJ)))
(setq PT1 (cdr (assoc 10 ENT)))
(setvar "osnapcoord" 1)

;; Get second point
(while (not PT2)
(setq PT2 (getpoint PT1 "\nPick array end point: "))
)

;; Compute distance, angle, and spacing
(setq PTANG (angle PT1 PT2))
(setq SPACE (/ (getdist "\nEnter spacing: ") LFAC))
(setq PT-DIST (distance PT1 PT2))
(setq NUMTO (fix (/ PT-DIST SPACE)))

;; Ensure at least one object is copied
(if (= NUMTO 0)
(princ "\nSpacing too large for array.")
(progn
;; Compute exact spacing to ensure alignment
(setq SPACE (/ PT-DIST NUMTO))

;; Loop through and copy objects with exact placement
(setq i 1)
(while (<= i NUMTO)
(setq NEWPT (list (+ (car PT1) (* i SPACE (cos PTANG)))
(+ (cadr PT1) (* i SPACE (sin PTANG)))))
(command "copy" ENTOBJS "" PT1 NEWPT)
(setq i (1+ i))
)
)
)

(princ (strcat "\n" (itoa NUMTO) " objects arrayed with exact spacing: " (rtos SPACE 2 4)))
)
)
(princ)
)

[BigBoyCAD]

Hi Sea-Haven.

Thank you for this.

This code worked perfectly with 2 different max spacings.

Though with all other max spacings... There was one less object copied than required.

Aside from this it worked well.

Almost there with this.

[BigBoyCAD]

Below is a LISP routine that successfully allows the user to determine max spacing.
Though it creates points upon which the user needs to the manually copy objects onto.

I would like to combine the first element with a copy-array-fit sequence.

(setq SPC$ 1200)
(defun C:SPACE ()
(command "PDMODE" "3")
(setq PT1 (getpoint "\nFirst point: "))
(if (null PT1) (exit))
(setq PT2 nil)
(while (null PT2)
(setq PT2 (getpoint pt1 "\nSecond point: "))
)
(setq XD (float (distance PT1 PT2)))
(princ "\nDistance: ") (princ XD)
(setq SPC (getreal (strcat "\nEnter MAX. spacing <" (rtos SPC$ 2 1) ">: ")))
(if (null SPC) (setq SPC SPC$) (setq SPC$ SPC))
(setq TSPC (/ XD SPC))
(if (rem XD SPC)
(setq TSPC (+ (fix TSPC) 1))
)
(command ".LINE" PT1 PT2 "") (setq E (entlast))
(command ".MEASURE" (list E PT1) (/ XD TSPC))
(entdel E)
(command "PDMODE" "3")
(princ)
)

[komondormrex]

@BigBoyCAD 

hey,

just alternative, based on the original

(defun c:copy-array-fit-max-spacing (/ pt1 pt2 lfac ename_sset spacing numto direction index)
	(setq lfac (getvar 'dimlfac))
	(princ "\nSelect objects to array: ")
	(if (setq ename_sset (ssget))
		(progn
			(setq pt1 (cdr (assoc 10 (entget (ssname ename_sset 0)))))
			;; Get second point
			(while (not pt2)
				(setq pt2 (getpoint pt1 "\nPick array end point: "))
			)
			;; Compute distance, angle, and spacing
			(setq spacing (/ (getdist "\nEnter spacing: ") lfac))
			(setq numto (fix (/ (distance pt1 pt2) spacing)))
			(setq direction (angle pt1 pt2)) 
			;; Ensure at least one object is copied
			(if (zerop numto)
				(princ "\nSpacing too large for array.")
				(progn
					;; Compute exact spacing to ensure alignment
					(setq spacing (/ (distance pt1 pt2) numto) index 1)
					(repeat numto
						(foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ename_sset)))
							(vla-move (vla-copy (vlax-ename->vla-object ename)) 
									  (vlax-3d-point pt1) 
									  (vlax-3d-point (polar pt1 direction (* spacing index)))
							) 
						)
						(setq index (1+ index))
					)
				)
			)
		)
	)
	(princ)
)

,  

[Sea-Haven]

Can you post the dwg bit that did not work please, use wblock etc, add text max spacing, one thing I found was that when the length was say 30000 and max was 1000 it left last one out so did a check for that so it did 31.

[BigBoyCAD]

Hi Sea-Haven.

Please see attached .dwg.
This is using the code put together by @komondormrex .

I changed the name to 'CAF1'

Thanks

[Sea-Haven]

I checked with my code and got answers as you wanted. Just change this line.

(setq maxd (getreal "\nEnter maximum spacing "))

[BigBoyCAD]

Hi Sea-Haven.

Could you possibly post the full LISP code here that you found to be working.

Just to confirm we are looking at the same thing.

It would be much appreciated.

[komondormrex]

@BigBoyCAD 

the source of that particular error is in the distance between points and function fix.

see for yourself. pt1, pt2 actual points from your example.

Command: (rtos (distance pt1 pt2) 2 16)
"29999.999999999"

it is not 30000! so fix gives you a 1 less number.

check the following updated code, where custom fix_ function is used.

(defun c:copy-array-fit-max-spacing (/ pt1 pt2 lfac ename_sset spacing numto direction index)
	(defun fix_ (number)
		(if (< (rem number 1) 0.5) (fix number) (1+ (fix number)))
	)
	(setq lfac (getvar 'dimlfac))
	(princ "\nSelect objects to array: ")
	(if (setq ename_sset (ssget))
		(progn
			(setq pt1 (cdr (assoc 10 (entget (ssname ename_sset 0)))))
			;; Get second point
			(while (not pt2)
				(setq pt2 (getpoint pt1 "\nPick array end point: "))
			)
			;; Compute distance, angle, and spacing
			(setq spacing (/ (getdist "\nEnter spacing: ") lfac))
			(setq numto (fix_ (/ (distance pt1 pt2) spacing)))
			(setq direction (angle pt1 pt2)) 
			;; Ensure at least one object is copied
			(if (zerop numto)
				(princ "\nSpacing too large for array.")
				(progn
					;; Compute exact spacing to ensure alignment
					(setq spacing (/ (distance pt1 pt2) numto) index 1)
					(repeat numto
						(foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ename_sset)))
							(vla-move (vla-copy (vlax-ename->vla-object ename)) 
									  (vlax-3d-point pt1) 
									  (vlax-3d-point (polar pt1 direction (* spacing index)))
							) 
						)
						(setq index (1+ index))
					)
				)
			)
		)
	)
	(princ)
)

[Sea-Haven]

Updated my previous code just changed the enter max distance.

[BigBoyCAD · Accepted solution]

Hi @Sea-Haven.

Woohoo!! This sorted it.

Thank you very much and thank you to everyone that contributed their ideas to this.

It is much appreciated.

Also, the following code works successfully though has a couple of less steps.

I found this to be the most efficient:

(defun c:COPY-ARRAY-FIT-MAX-DISTANCE ( / pt1 pt2 ang maxd dist inc ent oldsnap howmanychk obj)

;; Select object to copy
(setq ent (car (entsel "\nPick object to copy ")))

;; If object is valid, proceed
(if ent
(progn
;; Get base point of object
(setq obj (entget ent))
(setq pt1 (cdr (assoc 10 obj))) ;; Extract base point

;; Get the second point from the user
(setq pt2 (getpoint "\nPick second point "))

;; Compute angle and distance
(setq ang (angle pt1 pt2))
(setq maxd (getreal "\nEnter max distance "))
(setq dist (distance pt1 pt2))
(setq howmanychk (/ dist maxd))

;; Determine how many copies
(if (< (- howmanychk (fix howmanychk)) 1e-8)
(setq howmany (fix howmanychk))
(setq howmany (+ (fix howmanychk) 1))
)
(setq inc (/ dist howmany))

;; Disable OSNAP
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

;; Perform copies
(setq off 0.0)
(repeat howmany
(command "copy" ent "" pt1 (polar pt1 ang (setq off (+ off inc))))
)

;; Restore OSNAP
(setvar 'osmode oldsnap)
)
)
(princ)
)