Jump to content

Dynamic Stretch Spacing


tzframpton

Recommended Posts

I'm inquiring to see if there's a LISP roaming around that allows you to select equally spaced 2D objects (usually identical objects) then stretch them along any axis with the cursor, maintaining an equal distance as you lengthen or shorten the overall distance. I'm not looking to use the current Array function as it's cumbersome, but if a good Macro or equivalent exists to make my life easier on this, I'd surely but up to it as well.

 

Hopefully that made sense. Thanks in advance!! :)

Link to comment
Share on other sites

That certainly sounds familiar I just can't recall where I saw a dynamic block like that. I'm kind of surprised you did not find one yourself. You tend to be pretty resourceful.

 

Maybe over at the AUGI website?

Link to comment
Share on other sites

That certainly sounds familiar I just can't recall where I saw a dynamic block like that. I'm kind of surprised you did not find one yourself. You tend to be pretty resourceful.

 

Maybe over at the AUGI website?

I'm not looking for a dynamic block.... just want to select entities and stretch. Say, four circles spaced 1" apart (4" total). Select them and pick the first circle cen pt1 then the last circle cen pt2 then stretch to 8", all four circles would be now 2" apart.

 

And I've searched online with Google on this site and a couple others and can't find exactly what I'm looking for. I'm positive it exists though.

Link to comment
Share on other sites

Once again, it sounds awfully familiar but I just can't recall where I may have come across something like that unless it was one of Lee Mac's custom lisp routines. Maybe his Dynamic Offset routine?

Link to comment
Share on other sites

I would suggest you work with the array command and get familiar with it. What you want to do is pretty easy with the associative array properties. I like OOTB solutions rather than the add ons, but that is just me.

Link to comment
Share on other sites

Try the following Tannar:

([color=BLUE]defun[/color] c:myarray ( [color=BLUE]/[/color] a b d i l o p q s v )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify start point of array: "[/color]))
           ([color=BLUE]setq[/color] q ([color=BLUE]getpoint[/color] p [color=MAROON]"\nSpecify ent point of array: "[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] v ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] q p))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] o ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
               ([color=BLUE]vla-getboundingbox[/color] o 'a 'b)
               ([color=BLUE]setq[/color] l
                   ([color=BLUE]cons[/color]
                       ([color=BLUE]cons[/color] o
                           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0))
                               ([color=BLUE]vlax-safearray->list[/color] a)
                               ([color=BLUE]vlax-safearray->list[/color] b)
                           )
                       )
                       l
                   )
               )
           )
           ([color=BLUE]setq[/color] l
               ([color=BLUE]vl-sort[/color] l
                  '([color=BLUE]lambda[/color] ( a b )
                       ([color=BLUE]<[/color]  ([color=BLUE]caddr[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] a) 0 v))
                           ([color=BLUE]caddr[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] b) 0 v))
                       )
                   )
               )
           )
           ([color=BLUE]setq[/color] n ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] l) ([color=BLUE]1-[/color] ([color=BLUE]length[/color] l)) 1.0)
                 v ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] v ([color=BLUE]list[/color] n n n))
                 p ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdar[/color] l) v)
           )
           ([color=BLUE]foreach[/color] x ([color=BLUE]cdr[/color] l)
               ([color=BLUE]vlax-invoke[/color] ([color=BLUE]car[/color] x) 'move ([color=BLUE]cdr[/color] x) p)
               ([color=BLUE]setq[/color] p ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] p v))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites

  • 10 months later...
Try the following Tannar:

([color=BLUE]defun[/color] c:myarray ( [color=BLUE]/[/color] a b d i l o p q s v )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify start point of array: "[/color]))
           ([color=BLUE]setq[/color] q ([color=BLUE]getpoint[/color] p [color=MAROON]"\nSpecify ent point of array: "[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] v ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] q p))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] o ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
               ([color=BLUE]vla-getboundingbox[/color] o 'a 'b)
               ([color=BLUE]setq[/color] l
                   ([color=BLUE]cons[/color]
                       ([color=BLUE]cons[/color] o
                           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0))
                               ([color=BLUE]vlax-safearray->list[/color] a)
                               ([color=BLUE]vlax-safearray->list[/color] b)
                           )
                       )
                       l
                   )
               )
           )
           ([color=BLUE]setq[/color] l
               ([color=BLUE]vl-sort[/color] l
                  '([color=BLUE]lambda[/color] ( a b )
                       ([color=BLUE]<[/color]  ([color=BLUE]caddr[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] a) 0 v))
                           ([color=BLUE]caddr[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] b) 0 v))
                       )
                   )
               )
           )
           ([color=BLUE]setq[/color] n ([color=BLUE]if[/color] ([color=BLUE]cdr[/color] l) ([color=BLUE]1-[/color] ([color=BLUE]length[/color] l)) 1.0)
                 v ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] v ([color=BLUE]list[/color] n n n))
                 p ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] ([color=BLUE]cdar[/color] l) v)
           )
           ([color=BLUE]foreach[/color] x ([color=BLUE]cdr[/color] l)
               ([color=BLUE]vlax-invoke[/color] ([color=BLUE]car[/color] x) 'move ([color=BLUE]cdr[/color] x) p)
               ([color=BLUE]setq[/color] p ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] p v))
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Wow! It works like charm!... It has only one little flaw: in random UCS it does somewhat unexpected results

Link to comment
Share on other sites

Wow! It works like charm!... It has only one little flaw: in random UCS it does somewhat unexpected results

 

Thanks! The following may solve the UCS issue, but I have not thoroughly tested it:

 

(defun c:myarray ( / a b d i l o p q s v )
   (if
       (and
           (setq s (ssget "_:L"))
           (setq p (getpoint "\nSpecify start point of array: "))
           (setq q (getpoint p "\nSpecify end point of array: "))
       )
       (progn
           (setq v (trans (mapcar '- q p) 1 0 t))
           (repeat (setq i (sslength s))
               (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
               (vla-getboundingbox o 'a 'b)
               (setq l
                   (cons
                       (cons o
                           (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                               (vlax-safearray->list a)
                               (vlax-safearray->list b)
                           )
                       )
                       l
                   )
               )
           )
           (setq l
               (vl-sort l
                  '(lambda ( a b )
                       (<  (caddr (trans (cdr a) 0 v))
                           (caddr (trans (cdr b) 0 v))
                       )
                   )
               )
           )
           (setq n (if (cdr l) (1- (length l)) 1.0)
                 v (mapcar '/ v (list n n n))
                 p (mapcar '+ (cdar l) v)
           )
           (foreach x (cdr l)
               (vlax-invoke (car x) 'move (cdr x) p)
               (setq p (mapcar '+ p v))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Link to comment
Share on other sites

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.

×
×
  • Create New...