Jump to content

Lisp in order to place several 2d objects into equal distances at a given length

ALKISTI

By ALKISTI
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

rkent Grand Master

rkent

Posted
Posted

Given your example, draw a line across the width you are needing to divide, stretch each endpoint 75 making the line 150 wider. Now use divide, place the rectangles at their mid point to each node with copy and then array. I believe this will work, not the lisp command you were after however.

  • Replies 53
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    16

  • ALKISTI

    14

  • Commandobill

    7

  • rkent

    6

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Tharwat Grand Master

Tharwat

Posted
Posted

Try this and let me know .

 

(defun c:Test (/ *error* EnoughSpace-p cm a b ss i sn x d l g pt lft r
              stp k u x-d xXx dis
             )
 ;;      Tharwat Al Shoufi ~ 15. Aug. 2013    ;;
 (defun *error* (x)
   (princ "\n")
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n *Cancel*")
 )
 (defun EnoughSpace-p (ss d / l i q lf ur p)
   (setq l 0.)
   (repeat (setq i (sslength ss))
     (vla-getboundingbox
       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
       'lf
       'ur
     )
     (setq l
            (+ (distance (setq p (vlax-safearray->list lf))
                         (list (car (vlax-safearray->list ur)) (cadr p) 0.)
               )
               l
            )
     )
   )
   (list (< l d) l)
 )
 (if
   (and (setq dis (getdist "\n Specify total length :"))
        (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
        (if (car (setq g (EnoughSpace-p ss dis)))
          t
          (progn
            (alert
              "Total length is less than the total widths of Rectangles !!"
            )
            nil
          )
        )
   )
    (progn
      (setq cm (getvar 'cmdecho)
            g  (/ (- dis (cadr g)) (1- (sslength ss)))
      )
      (setvar 'cmdecho 0)
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i))))
        (vla-getboundingbox (vlax-ename->vla-object sn) 'lft 'r)
        (setq x (vlax-safearray->list lft))
        (setq d
               (distance x (list (car (vlax-safearray->list r)) (cadr x)))
        )
        (setq l (cons (list sn x d) l))
      )
      (setq l (vl-sort l
                       '(lambda (q p) (< (car (cadr q)) (car (cadr p))))
              )
            k 0
      )
      (setq stp 0.
            a   (car (cadr (nth 0 l)))
            b   (last (nth 0 l))
      )
      (repeat (1- (length l))
        (setq k (1+ k))
        (vl-cmdf "_.move"
                 (car (nth k l))
                 ""
                 "_non"
                 (cadr (nth k l))
                 "_non"
                 (list (+ a b g stp) (cadr (cadr (nth k l))))
        )
        (setq stp (+ (last (nth k l)) g stp))
      )
      (setvar 'cmdecho cm)
    )
 )
 (princ)
)
(vl-load-com)

ALKISTI Apprentice

ALKISTI

Posted
  • Author
Posted
Try this and let me know .

 

(defun c:Test (/ *error* EnoughSpace-p cm a b ss i sn x d l g pt lft r
              stp k u x-d xXx dis
             )
 ;;      Tharwat Al Shoufi ~ 15. Aug. 2013    ;;
 (defun *error* (x)
   (princ "\n")
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n *Cancel*")
 )
 (defun EnoughSpace-p (ss d / l i q lf ur p)
   (setq l 0.)
   (repeat (setq i (sslength ss))
     (vla-getboundingbox
       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
       'lf
       'ur
     )
     (setq l
            (+ (distance (setq p (vlax-safearray->list lf))
                         (list (car (vlax-safearray->list ur)) (cadr p) 0.)
               )
               l
            )
     )
   )
   (list (< l d) l)
 )
 (if
   (and (setq dis (getdist "\n Specify total length :"))
        (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
        (if (car (setq g (EnoughSpace-p ss dis)))
          t
          (progn
            (alert
              "Total length is less than the total widths of Rectangles !!"
            )
            nil
          )
        )
   )
    (progn
      (setq cm (getvar 'cmdecho)
            g  (/ (- dis (cadr g)) (1- (sslength ss)))
      )
      (setvar 'cmdecho 0)
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i))))
        (vla-getboundingbox (vlax-ename->vla-object sn) 'lft 'r)
        (setq x (vlax-safearray->list lft))
        (setq d
               (distance x (list (car (vlax-safearray->list r)) (cadr x)))
        )
        (setq l (cons (list sn x d) l))
      )
      (setq l (vl-sort l
                       '(lambda (q p) (< (car (cadr q)) (car (cadr p))))
              )
            k 0
      )
      (setq stp 0.
            a   (car (cadr (nth 0 l)))
            b   (last (nth 0 l))
      )
      (repeat (1- (length l))
        (setq k (1+ k))
        (vl-cmdf "_.move"
                 (car (nth k l))
                 ""
                 "_non"
                 (cadr (nth k l))
                 "_non"
                 (list (+ a b g stp) (cadr (cadr (nth k l))))
        )
        (setq stp (+ (last (nth k l)) g stp))
      )
      (setvar 'cmdecho cm)
    )
 )
 (princ)
)
(vl-load-com)

 

There is a promt to specify the length, then the object..and then nothing happens..

Tharwat Grand Master

Tharwat

Posted
Posted

What are the objects you are trying to select ?

Are they closed polylines ?

ALKISTI Apprentice

ALKISTI

Posted
  • Author
Posted

yes, just closed polylines-simple rectangles !

ALKISTI Apprentice

ALKISTI

Posted
  • Author
Posted

I want to pick only one object - no more

Tharwat Grand Master

Tharwat

Posted
Posted
I want to pick only one object - no more

 

You want to select only one closed polyline and the routine should copy it according to the specified length ?

Tharwat Grand Master

Tharwat

Posted
Posted

My routine should ask the user to specify a length and to select closed polylines and after that the codes should relocate them equally according

to the total length and nothings more .

ALKISTI Apprentice

ALKISTI

Posted
  • Author
Posted

yes, I want to copy a specific number(that I would like to decide this number every time judging by how much dense I wanna it look) of rectangles of a given size - at given length in equal distances ( I dont care about the length of the gaps) . calculating it is very very very simple that why i thougth that there might be a lisp routine

length of rectangles*number of rectangles that I want to place +number of gaps*length of one gap= total length

 

length of rectangles=given

number of rectangles that I want to place=given

number of gaps=given (number of rectangles+1)

length of one gap=?

total length=given

 

I have to go now .here is very late. thank you for your help and time! best regards, alkisti :)

rkent Grand Master

rkent

Posted
Posted (edited)
Given your example, draw a line across the width you are needing to divide, stretch each endpoint 75 making the line 150 wider. Now use divide, place the rectangles at their mid point to each node with copy and then array. I believe this will work, not the lisp command you were after however.

 

After thinking about it some more I would use an associative array. Draw a line as explained above and use array, specify 2 more rectangles than are needed, use the COLumns option, after number you have another option for Total, use that, pick the end points of the line. Finally you can remove the first and last rectangle by holding down the ctrl key and selecting and erasing.

 

Tharwat - I tried your lisp routine and it doesn't seem to work for me.

Edited by rkent
corrected a user name
Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this quick draft:

 

[color=GREEN];; My Array  -  Lee Mac[/color]
[color=GREEN];; A custom array program.[/color]

([color=BLUE]defun[/color] c:myarray ( [color=BLUE]/[/color] dlt ent ext ins lst mid num obj pt1 pt2 sel spc tmp )
   ([color=BLUE]princ[/color] [color=MAROON]"\nSelect rectangle for array: "[/color])
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S:L"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]) (90 . 4) (-4 . [color=MAROON]"&="[/color]) (70 . 1))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] sel 0)
                 lst ([color=BLUE]mapcar[/color] '[color=BLUE]cdr[/color] ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) ([color=BLUE]entget[/color] ent)))
                 ext ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] x lst))) '([color=BLUE]min[/color] [color=BLUE]max[/color]))
                 wid ([color=BLUE]-[/color] ([color=BLUE]caadr[/color] ext) ([color=BLUE]caar[/color] ext))
           )
           ([color=BLUE]while[/color]
               ([color=BLUE]and[/color]
                   ([color=BLUE]setq[/color] pt1 ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify first corner of array window <Exit>: "[/color]))
                   ([color=BLUE]setq[/color] pt2 ([color=BLUE]getcorner[/color] pt1 [color=MAROON]"\nSpecify opposite corner <Exit>: "[/color]))
                   ([color=BLUE]setq[/color] tmp ([color=BLUE]mapcar[/color] '[color=BLUE]min[/color] pt1 pt2)
                         pt2 ([color=BLUE]mapcar[/color] '[color=BLUE]max[/color] pt1 pt2)
                         pt1 tmp
                   )
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]while[/color]
                           ([color=BLUE]and[/color]
                               ([color=BLUE]progn[/color]
                                   ([color=BLUE]initget[/color] 6)
                                   ([color=BLUE]setq[/color] num ([color=BLUE]getint[/color] [color=MAROON]"\nSpecify number of objects <Exit>: "[/color]))
                               )
                               ([color=BLUE]minusp[/color] ([color=BLUE]setq[/color] dlt ([color=BLUE]-[/color] ([color=BLUE]-[/color] ([color=BLUE]car[/color] pt2) ([color=BLUE]car[/color] pt1)) ([color=BLUE]*[/color] num wid))))
                           )
                           ([color=BLUE]princ[/color] [color=MAROON]"\nObjects will overlap!"[/color])
                       )
                       ([color=BLUE]numberp[/color] num)
                   )
                   ([color=BLUE]setq[/color] spc ([color=BLUE]/[/color] dlt ([color=BLUE]1+[/color] num))
                         ins ([color=BLUE]list[/color] ([color=BLUE]+[/color] spc ([color=BLUE]/[/color] wid 2.0) ([color=BLUE]car[/color] pt1)) ([color=BLUE]/[/color] ([color=BLUE]+[/color] ([color=BLUE]cadr[/color] pt1) ([color=BLUE]cadr[/color] pt2)) 2.0) 0.0)
                         obj ([color=BLUE]vlax-ename->vla-object[/color] ent)
                         mid ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] ext)) '(2.0 2.0)) ent 0)
                   )                    
                   ([color=BLUE]repeat[/color] num
                       ([color=BLUE]vlax-invoke[/color] ([color=BLUE]vla-copy[/color] obj) 'move mid ([color=BLUE]trans[/color] ins 1 0))
                       ([color=BLUE]setq[/color] ins ([color=BLUE]cons[/color] ([color=BLUE]+[/color] ([color=BLUE]car[/color] ins) wid spc) ([color=BLUE]cdr[/color] ins)))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Usage:

 

myarray.gif

rkent Grand Master

rkent

Posted
Posted
Try this quick draft:

...

 

Brilliant, as usual.

Tharwat Grand Master

Tharwat

Posted
Posted

Thwart - I tried your lisp routine and it doesn't seem to work for me.

^^^ What is this ?

rkent Grand Master

rkent

Posted
Posted
^^^ What is this ?

 

Tharwat, if you are asking about the misspelling of your user name it was accidental, otherwise I was simply telling you that I tried your lisp routine and couldn't figure out how to make it work.

Tharwat Grand Master

Tharwat

Posted
Posted
Tharwat, if you are asking about the misspelling of your user name it was accidental, .

You wrote my name wrongly and I could accept that if you made a mistake with one character but not completely and it has a meaning .

 

otherwise I was simply telling you that I tried your lisp routine and couldn't figure out how to make it work.

 

My code should ask a user to specify a length and after that the user should select closed polylines to rearrange them according to the given length

from the user .

rkent Grand Master

rkent

Posted
Posted
You wrote my name wrongly and I could accept that if you made a mistake with one character but not completely and it has a meaning .

 

 

Tharwat - Please accept my sincere apologies, as I wrote earlier it was purely accidental.

Tharwat Grand Master

Tharwat

Posted
Posted
Tharwat - Please accept my sincere apologies, as I wrote earlier it was purely accidental.

 

It is okay , thank you for understanding what that meant to me .

 

But now I need to know if you tried my code with the description that I did in my last post for you to give it a go .

rkent Grand Master

rkent

Posted
Posted

I tried your lisp several times, it asks for the total length which I either type or pick points on screen, then it asks me to select objects, I pick one rectangle, I hit enter and nothing happens.

 

Edit - I see that you are supposed to have several rectangles to pick and then it will distribute them. Unfortunately it doesn't distribute them inside the length specified or as expected. I named your file Spacerect.lsp instead of test.lsp.

SPACERECT.jpg

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.

×
 Share
Go to topic listing
×
×
  • Create New...