TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: hudster on October 06, 2005, 05:13:39 AM
-
This is a stump the swamp question.
I don't know how to do it, and it's something i'm thinking about.
How woudl you array an object a set distance from a central location, arraying in all directions as per the following diagram.
(http://www.theswamp.org/screens/hudster/array.jpg)
-
2 separate polar array calls wrapped in a little ditty of a function.
-
Ok, I've had a coffee. My logic is flawed, one would have to calculate the matrix of offsets and then copy from the basepoint to each target offset. Seems to me I did something like this but it was about 12 years ago. Ackkk, searching ...
-
Consider ...
(setq matrix
'(
(-2 2) (-1 2) (0 2) (1 2) (2 2)
(-2 1) (-1 1) (0 1) (1 1) (2 1)
(-2 0) (-1 0) (0 0) (1 0) (2 0)
(-2 -1) (-1 -1) (0 -1) (1 -1) (2 -1)
(-2 -2) (-1 -2) (0 -2) (1 -2) (2 -2)
)
)
(setq scale 42.0)
(setq scaledMatrix
(mapcar
'(lambda (point)
(mapcar
'(lambda (ordinate) (* scale ordinate))
point
)
)
matrix
)
)
(setq ReferencePoint '( 100 100 ))
(setq offsetMatrix
(mapcar
'(lambda (point)
(mapcar '+ point ReferencePoint)
)
scaledMatrix
)
)
-
Consider ...
I don't care what anyone else says, That IS pretty ...
-
It'd be a roll yer own routine for sure ... something like a rectangular array with a "from center" option
-
OK then, just to add a wee bit to this.
How would you do it if you had to array an object the same way but it was off centre? As shown in this image.
(http://www.theswamp.org/screens/hudster/array2.jpg)
-
I believe you may be looking for the MatrixOmatic ...
(defun MatrixOmatic ( m n / *error* foo )
(defun *error* (msg)
(princ
(strcat
"Syntax: "
(chr 40)
"MakeMatrix m n"
(chr 41)
" where m and n are positive integers."
)
)
(princ)
)
(if
(not
(vl-every
'(lambda (x)
(and
(eq 'int (type x))
(< 0 x)
)
)
(list m n)
)
)
(exit)
)
(defun foo ( x / result )
( (lambda (k)
(repeat x
(setq result
(cons
(setq k (1- k))
result
)
)
)
)
(+ 0.5 (/ x 2.0))
)
)
(apply 'append
(mapcar
'(lambda (y)
(mapcar
'(lambda (x) (list x y))
(foo m)
)
)
(foo n)
)
)
)
(MatrixOmatic 4 3)
(
(-1.5 -1.0) (-0.5 -1.0) (0.5 -1.0) (1.5 -1.0)
(-1.5 0.0) (-0.5 0.0) (0.5 0.0) (1.5 0.0)
(-1.5 1.0) (-0.5 1.0) (0.5 1.0) (1.5 1.0)
)
:)
-
:-o :lol: :roll: WOW - neat stuff
-
You could set the first option up as a dynamic block with 4 rect. arrays.
-
I haven't had a chance to run your code MP, but it looks awesome. Elegant algorithm.
-
Thanks Steve, nice of you to say.
Here's a quick and dirty implementation of what Mr. Hudster wants (I think):
(defun ArraySelectionAndDelete
(
ss
basepoint
rows
columns
xoffset
yoffset
/
*error*
makematrix
matrix
cmdecho
)
;; our help message
(defun *error* (msg)
(princ
(strcat
"Syntax: "
(chr 40)
"ArraySelectionAndDelete "
"ss "
"basepoint "
"rows "
"columns "
"xoffset "
"yoffset"
(chr 41)
"\nWhere ss is a valid selection set\n"
" basepoint is a 2D or 3D point\n"
" rows is a positive integer\n"
" columns is a positive integer\n"
" xoffset is a positive real\n"
" yoffset is a positive real\n"
)
)
(princ)
)
;; this does the real grunt work
(defun makematrix ( m n / foo )
;; no need to error trap me, my
;; parent coding takes care of
;; making sure I get good data
(defun foo ( x / result )
( (lambda (k)
(repeat x
(setq result
(cons
(setq k (1- k))
result
)
)
)
)
(+ 0.5 (/ x 2.0))
)
)
(apply 'append
(mapcar
'(lambda (y)
(mapcar
'(lambda (x) (list x y))
(foo m)
)
)
(foo n)
)
)
)
;; bozo filtering
(if
(or
(not (eq 'pickset (type ss)))
(not (< 0 (sslength ss)))
(not (listp basepoint))
(not (< 1 (length basepoint) 4))
(not (vl-every 'numberp basepoint))
(not
(vl-every
'(lambda (x)
(and
(eq 'int (type x))
(< 0 x)
)
)
(list rows columns)
)
)
(not
(vl-every
'(lambda (x)
(and
(numberp x)
(< 0 x)
)
)
(list xoffset yoffset)
)
)
)
(exit)
)
;; we're good, let's calculate
;; all the target points
( (lambda (offset)
(setq matrix
(mapcar
'(lambda (point)
(mapcar '+
(mapcar '* point offset)
basepoint
)
)
(makematrix
rows
columns
)
)
)
)
(list xoffset yoffset)
)
;; shhhh ...
(setq cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
;; make all the copies
(foreach point matrix
(command
".copy"
ss
""
"_non"
basepoint
"_non"
point
)
)
;; trap a locked layers fubar
(vl-catch-all-apply
'(lambda ( )
(command
".erase"
ss
""
)
)
)
;; play nice
(setvar "cmdecho" cmdecho)
;; shhh ...
(princ)
)
Example implementation:
(defun c:ASAD ( / ss inibits )
(if (setq ss (ssget))
(ArraySelectionAndDelete
ss
(getpoint "\nSelect basepoint: ")
(progn
(initget (setq inibits (+ 1 2 4)))
(getint "Enter rows: ")
)
(progn
(initget inibits)
(getint "Enter columns: ")
)
(progn
(initget inibits)
(getdist "Enter xoffset: ")
)
(progn
(initget inibits)
(getdist "Enter yoffset: ")
)
)
)
(princ)
)
Like I said, pretty quick and dirty but demonstrates (I hope) the general idea.
-
Possible pseudo code
User select objects (or entsel)
Get user pick center
...or get corner of bounding box
Copy object(s) with base point
Get number of array rows & columns
get offset amount(s) (row & col)
Get point offsets (MatrixOmatic rows columns)
Loop point offsets, adding offset to point
.. paste selection set to new point
PS too late but I'll post anyway
Let me see how close I got :roll:
-
:-o you guys are amazing, the best I could come up with was an idea to array it in four directions, but then i had duplicates and gave up.
It's timnes like this when I realise how little I know, and how far I still have to go.
-
Hey Mr. Hudster -- please don't belittle or dismiss your talents -- everyone can learn this stuff -- it just takes genuine interest and time. It's obvious you have the interest, just not the time, 'cause like most folks programming isn't your primary vocation or interest.
So keep posting the ideas and questions, grab and digest as much as your time and interest affords and thanks for letting folks like me pitch in. I enjoy it and need to challenge what I think I know if I want to get better at this. In other words, you're doing me a great favor when you post challenges like this.
So thanks!
(http://www.theswamp.org/screens/mp/nodding.gif)
-
I think all bases are covered - Good job Michael
-
Thanks Louis, nice acknowledgement considering the source. 8-)
One thing I do want to say about this function (and a few others I've offered lately) --
(defun MatrixOmatic ( m n / *error* foo )
(defun *error* (msg)
(princ
(strcat
"Syntax: "
(chr 40)
"MakeMatrix m n"
(chr 41)
" where m and n are positive integers."
)
)
(princ)
)
(if
(not
(vl-every
'(lambda (x)
(and
(eq 'int (type x))
(< 0 x)
)
)
(list m n)
)
)
(exit)
)
(defun foo ( x / result )
( (lambda (k)
(repeat x
(setq result
(cons
(setq k (1- k))
result
)
)
)
)
(+ 0.5 (/ x 2.0))
)
)
(apply 'append
(mapcar
'(lambda (y)
(mapcar
'(lambda (x) (list x y))
(foo m)
)
)
(foo n)
)
)
)
I normally don't provide the kind of hand holding, caller protected code you see therein and I would never place something like that in my libraries. It's good when you're starting out 'cause it identifies where you may have supplied invalid arguments; precisley why I penned it this way.
However, =in my opinion= code like this has no place in a library. Library code should be lean and mean -- if it gets passed invalid arguments it should crash; calling (hi level) code should deal with errors, not low level functions.
Do native lisp functions hand hold or crash I ask rhetorically? Put this in a lisp program and see what happens: (/ 1 0).
So my point is this, what I'd put in my library would be more like this:
(defun MatrixOmatic ( m n / foo )
(defun foo ( x / result )
( (lambda (k)
(repeat x
(setq result
(cons
(setq k (1- k))
result
)
)
)
)
(+ 0.5 (/ x 2.0))
)
)
(apply 'append
(mapcar
'(lambda (y)
(mapcar
'(lambda (x) (list x y))
(foo m)
)
)
(foo n)
)
)
)
It's eactly what it needs to be and no more.
:)
-
OK, I went to my very very old lisps and found this one [1992] it may be useful today, just excuse the style and the no default features.
What RECTGRID does is to paint rectangles row-column inside of a rectangle area, the user will be ask to define a rectangle area, and the number of rows and columns and the separation between them.... well see if it works today's
Have fun,
Luis
(defun C:RECTGRID
(/ p1 p2 g k n m xo yo x y h l a b c d test sep osm olderr)
(setq olderr *error*
*error* err
osm (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(command "UNDO" "G")
(setvar "OSMODE" 0)
(setq P1 (getpoint "\nLower corner: ")
P2 (getcorner P1 "\nUpper corner: ")
N (getint "\nNumber of columns (|||): ")
M (getint "\nNumber of rows (--): "))
(setq Xo (car P1)
Yo (cadr P1)
X (- (car P2) Xo)
Y (- (cadr P2) Yo))
(setq tst T)
(while tst
(setq G (getdist "\nDistance between columns: "))
(if (< G (setq SEP (/ (abs x) (+ N 1))))
(setq tst nil)
(prompt
(strcat "\nDistance must be lower than " (rtos SEP 2 3)))))
(setq tst T)
(while tst
(setq K (getdist "\nDistance between rows: "))
(if (< K (setq SEP (/ (abs y) (+ M 1))))
(setq tst nil)
(prompt
(strcat "\nDistance must be lower than " (rtos SEP 2 3)))))
(if (minusp x)
(setq sx -1)
(setq sx 1))
(if (minusp y)
(setq sy -1)
(setq sy 1))
(setq G (* sx G)
K (* sy K)
H (/ (- Y (* (+ M 1) K)) M)
L (/ (- X (* (+ N 1) G)) N)
A (list (+ Xo G) (+ Yo K))
B (list (+ Xo G L) (+ Yo K))
C (list (+ Xo G) (+ Yo K H))
D (list (+ Xo G L) (+ Yo K H)))
(command "PLINE" A "W" 0 0 B D C A "")
(if (and (= M 1) (= N 1))
nil
(progn
(command "ARRAY" (entlast) "" "R" M N)
(cond
((and (> M 1) (> N 1))
(command (+ H K) (+ L G)))
((and (= M 1) (> N 1))
(command (+ L G)))
((and (> M 1) (= N 1))
(command (+ H K))))))
(command "UNDO" "E")
(setvar "CMDECHO" 1)
(setvar "OSMODE" osm)
(setq *error* olderr)
(princ))
(defun err (s)
(princ (strcat "\nError: " s))
(command "UNDO" "E")
(setvar "CMDECHO" 1)
(setvar "OSMODE" osm)
(setq *error* olderr)
(princ))
(princ)
-
Almost looks like it were made for laying out (concrete) piles Louis.
:)
-
It was the early stage for then another one.... to draw window elevations.... and yes it was in those days the original idea.... o man you definitely read minds [experience is shown from your part].... :-o
-
... o man you definitely read minds ...
We should talk Louis, give me a call sometime: 1-800-LSP-JOJO.
:lmao:
-
He he....
I have not put so much effort lately in lisp coding.... but yes, there must be a place for those lispaholic's or whatever that could sound in English.
I kept that phone number in case is needed it is a 24/7 service no?
-
Pretty close, probably 12/6.
:)
-
I tried that number.....kinky phone sex.......sounds just like MP......
-
Hi Hudster
Sorry I badly know mathematics of an elementary school
Therefore I have solved a problem by means of standard
AutoCAD commands
Try as it will work for you
Thank you
F.
(defun C:tst (/ cell col col_step coors cpt en mark
mpt prot row row_dist row_step sset)
(while (= (rem
(setq row (getint "\n\tNumber of rows <odd number only> :\n\t"))
2)
0))
(while (= (rem
(setq col (getint "\n\tNumber of columns <odd number only> :\n\t"))
2)
0))
(setq row_step (getreal "\n\tRow offset :\n\t")
col_step (getreal "\n\tColumn offset :\n\t")
cell (car (entsel "\nSelect object to array :"))
sset (ssadd)
)
(setq row_dist (* (/ (1- row) 2) row_step)
coors (vl-remove-if
(function not)
(mapcar (function (lambda (x)
(if (eq 10 (car x))
(trans (cdr x) 1 0))))
(entget cell)))
cpt (mapcar '/ (mapcar '+ (car coors) (caddr coors)) '(2 2 2))
mpt (list (car cpt) (- (cadr cpt) row_dist) (cadr cpt)))
(command "copy" cell "" '(0. 0. 0.) '(0. 0. 0.))
(setq prot (entlast))
(command "move" prot "" cpt mpt)
(command "-array" prot "" "R" 1 (/ (1+ col) 2) col_step)
(setq en (entnext prot))
(ssadd en sset)
(while (setq en (entnext en))
(ssadd en sset)
)
;;;(sssetfirst nil sset);for test/debug only
;;;(sssetfirst);for test/debug only
(setq mark (entlast))
(ssdel prot sset)
(setq mark (entlast))
(command "mirror" sset "" cpt mpt "")
(setq en (entnext mark))
(ssadd en sset)
(while (setq en (entnext en))
(ssadd en sset)
)
(ssadd prot sset)
(command "-array" sset "" "R" row 1 row_step)
(command "erase" cell "")
(command "zoom" "e")
(princ)
)