AutoLISP: Array Rectanglular

Following the previous post concerning alternate array routines: here is one that is similar to the previous except that you can make rectangular arrays. Again, thanks to Lee-Mac.

Here’s how:

  • RECARR <enter> to start (RECtangular ARRay)
  • Select object(s) to be arrayed <enter>
  • Specify Base point (pick a point)
  • Specify distance for X direction (pick a point)
  • Specify distance for Y direction (pick a point)
  • Move your cursor in the direction until you get the desired amount of rows & columns and then click to place the array.

;; by Lee-MAC found at the swamp

(defun c:recarr ( / ss->list copyv dx dy gr i1 i2 nx ny obs obx oby p0 px py vx vy ) (vl-load-com)

(defun ss->list ( ss / i l )

(if ss

(repeat (setq i (sslength ss))

(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))

)

)

)

(defun copyv ( ob n v / i b l ) (setq i 1 b (vlax-3D-point '(0. 0. 0.)))

(repeat n

(foreach obj ob

(vla-move (car (setq l (cons (vla-copy obj) l))) b (vlax-3D-point (mapcar '* v (list i i i))))

)

(setq i (1+ i))

)

l

)

(if

(and

(setq obs (ss->list (ssget '((0 . "~VIEWPORT")))))

(setq p0 (getpoint "\nBase Point (P0): "))

(setq px (getpoint "\nArray X-Vector (Px): " p0))

(setq py (getpoint "\nArray Y-Vector (Py): " p0))

)

(progn

(setq vx (mapcar '- px p0) dx (distance '(0. 0. 0.) vx)

vy (mapcar '- py p0) dy (distance '(0. 0. 0.) vy)

)

(princ "\nArray Endpoint: ")

(while (= 5 (car (setq gr (grread 't 13 0)))) (redraw)

(setq obx (car (mapcar 'vla-delete obx))

oby (car (mapcar 'vla-delete oby))

gr (mapcar '- (cadr gr) p0)

i1 (inters '(0. 0. 0.) vx gr (mapcar '+ gr vy) nil)

i2 (inters '(0. 0. 0.) vy gr (mapcar '+ gr vx) nil)

nx (fix (/ (caddr (trans i1 1 vx)) dx))

ny (fix (/ (caddr (trans i2 1 vy)) dy))

obx (copyv obs (abs nx) (mapcar (if (minusp nx) '- '+) vx))

oby (copyv (append obs obx) (abs ny) (mapcar (if (minusp ny) '- '+) vy))

)

(grvecs (list -3 '(0. 0. 0.) i1 i1 gr '(0. 0. 0.) i2 i2 gr)

(list

(list 1. 0. 0. (car p0))

(list 0. 1. 0. (cadr p0))

(list 0. 0. 1. (caddr p0))

(list 0. 0. 0. 1.)

)

)

)

)

)

(redraw) (princ)

)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Modifying, New in 2012, TIPS. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s