Author Topic: Array Question  (Read 7118 times)

0 Members and 1 Guest are viewing this topic.

LE

  • Guest
Re: Array Question
« Reply #15 on: October 07, 2005, 10:06:05 AM »
I think all bases are covered - Good job Michael

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Array Question
« Reply #16 on: October 07, 2005, 10:23:05 AM »
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) --

Code: [Select]
(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:

Code: [Select]
(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.

:)

Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

LE

  • Guest
Re: Array Question
« Reply #17 on: October 07, 2005, 10:59:36 AM »
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

Code: [Select]
(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)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Array Question
« Reply #18 on: October 07, 2005, 11:39:01 AM »
Almost looks like it were made for laying out (concrete) piles Louis.

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

LE

  • Guest
Re: Array Question
« Reply #19 on: October 07, 2005, 11:42:09 AM »
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

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Array Question
« Reply #20 on: October 07, 2005, 11:47:20 AM »
... o man you definitely read minds ...

We should talk Louis, give me a call sometime: 1-800-LSP-JOJO.

:lmao:
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

LE

  • Guest
Re: Array Question
« Reply #21 on: October 07, 2005, 11:54:48 AM »
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?


MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Array Question
« Reply #22 on: October 07, 2005, 12:13:45 PM »
Pretty close, probably 12/6.

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

t-bear

  • Guest
Re: Array Question
« Reply #23 on: October 08, 2005, 05:31:00 PM »
I tried that number.....kinky phone sex.......sounds just like MP......

Fatty

  • Guest
Re: Array Question
« Reply #24 on: October 09, 2005, 01:35:49 PM »
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.


Code: [Select]
(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)
  )