Need Lisp : create rectangle between rectangle

[MSasu]

Even if you do not master English very well, please don’t forget that there are available on-line translation tools that are doing quite a good job.

Alternatively you can post pictures to describe step by step the effect of the tool you are looking for:

 

[pBe]

That image you posted gave me an idea MSasu

So lets try agan:

 

[QUICK REVISION]

(defun c:BeatBox2 ( / _Box _Mirror _HiLow _mid _pts pts i re BoxSize p p1 d d2)
(vl-load-com)  
(defun _Box (p1 p2 [color=darkred][b]Flg[/b][/color]) (command "_rectang" "_non" p1 "_non" p2) (if flg (entlast)))
(setq _mid (lambda (f1 f2 lst)
     (mapcar'(lambda (a b) (/ (+ a b) 2.)) (f1 lst)(f2 lst))))  
(setq _HiLow (lambda (lev lst)
   (list (apply lev (mapcar 'car lst))(apply lev (mapcar 'cadr lst))
   )))
(setq _pts (lambda (e)
              (mapcar 'cdr (vl-remove-if-not
         '(lambda (j)
     (= (car j) 10) )
         (if (listp e) e (entget e)))
       )))
(while (and
        [color=black](princ "[color=blue][b]\nSelect 2 [Two/Ni/Due/Dalawa/Yih/Song/Twee/Två/Doi][/b][/color] or
        \nSelect 4 [Four/Shi/Quattro/Apat/Sei/Si/Vier/Fyra/[color=sienna][b]Patru][/b][/color] Rectangles:")
[/color]      (setq pts nil bx (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
        [color=blue][b](zerop (rem (setq i (sslength bx)) 2))[color=darkred](< 1 i 5)[/color])[/b][/color]
 (repeat i
   (setq pts (cons
               (_pts (ssname bx (setq i (1- i)))) pts)))
 (setq pts (apply 'append pts)
       Re (list (_HiLow 'min pts)(_HiLow 'max pts)))
 (vla-getboundingbox (vlax-ename->vla-object (ssname bx 0)) 'pt1 'pt2)
 (setq BoxSize  (mapcar 'vlax-safearray->list (list pt1 pt2)))
[color=blue][b](cond[/b][/color]
[b][color=blue]       ((= (length pts) 16)[/color][/b]
(setq Box1 (_box
          (setq p (polar (Car re) 0 (setq d1 (distance (car BoxSize)
                 (list (Caadr BoxSize)(cadar boxsize))))))
 (setq pt (list (car (polar (cadr re) pi d1))
                          (+ (setq d2 (distance (car BoxSize)
                 (list (caar BoxSize)(cadadr boxsize))))(cadr p)))) [b][color=darkred]T[/color][/b]))
          (setq Box2 (_box pt (polar (cadr re) (* pi 1.5) d2) [b]T[/b]))
   (vla-mirror (vlax-ename->vla-object Box1)
                  (vlax-3d-point (_mid car last (_pts Box2)))
                  (vlax-3d-point (_mid cadr caddr (_pts Box2))))
   (vla-mirror (vlax-ename->vla-object Box2)
                  (vlax-3d-point (_mid car cadr (_pts Box1)))
                  (vlax-3d-point (_mid last caddr (_pts Box1)))))
         [b][color=blue]((= (length pts) [/color][/b]
[b][color=blue]         (vla-getboundingbox (vlax-ename->vla-object (ssname bx 1)) 'pt1 'pt2)[/color][/b]
[b][color=blue](setq BoxSize2  (mapcar 'vlax-safearray->list (list pt1 pt2)))[/color][/b]
[b][color=blue]         [/color][color=darkred](if (and (equal (car boxsize)(append (Car re) (list (last (car boxsize)))))[/color][/b]
[color=darkred][b]                      (= (caar boxsize)(caar boxsize2)))[/b][/color]
[color=darkred][b]                  (_box (cadr boxsize)(car boxsize2) nil)[/b][/color]
[color=darkred][b]                  (if (= (cadar boxsize)(cadar boxsize2))[/b][/color]
[color=darkred][b]                                 (_box (cadr boxsize)(car boxsize2) nil)[/b][/color]
[color=darkred][b]                   (_box (car boxsize)(cadr boxsize2) nil))[/b][/color]
[color=darkred][b] )[/b][/color]
[color=darkred][b]        )[/b][/color]
         )


 )(princ)
 )

 

Conditions for this to "work" effectivley are:

You need to select 4 Rectangles at a time [or 2]

All four preferably the same size [or 2]

Location of the 4 again "preferably" symmetrical [or 2]

 

command: Beatbox2

Select 2 [Two/Ni/Due/Dalawa/Yih/Song/Twee/Två/Doi] or

Select 2 [Four/Shi/Quattro/Apat/Sei/Si/Vier/Fyra/Patru] Rectangles:

Select objects:

 

HTH

Edited April 29, 2012 by pBe
Quick Revsion/Condtion

[MSasu]

I rather saw it working in pairs (with automatic detection of horizontal / vertical case). But was expected the OP to clarify why he/she needs a routine for something that is solved so easily with AutoCAD's commands.

 

I like the "internationalization" of prompt - where to ask for support for my language, too?

[pBe]

I like the "internationalization" of prompt - where to ask for support for my language, too?

 

How could i've miss that one ... [updated prompt]

 

 

I rather saw it working in pairs (with automatic detection of horizontal / vertical case). But was expected the OP to clarify why he/she needs a routine for something that is solved so easily with AutoCAD's commands.

 

Its all for fun after all.

Code Updated: (quick and sloppy revsion)

Edited April 29, 2012 by pBe

[MSasu]

Oauu, what a speed!

Only if I got such support from other software suppliers...

[pBe]

Oauu, what a speed!

 

Need to get off my head before the "idea" slips away. Its a crappy code really, guess i'll "fissit" whenever the OP decides it "works" for him or not. The two selection mode could've been easily done by two pick points though, but the code is already written as such, so might as well incorporate it on the code as per selection approach

 

Only if I got such support from other software suppliers...

 

Arent we all, I know how you feel MSasu

 

[MOST RECENT UPDATE]... still crappy

....(p1 p2 [b][color=darkred]Flg[/color][/b])...
....(< 1 i 5)...
[b][color=darkred](if (and (equal (car boxsize)(append (Car re) (list (last (car boxsize)))))
                       (= (caar boxsize)(caar boxsize2)))
                   (_box (cadr boxsize)(car boxsize2) nil)
                   (if (= (cadar boxsize)(cadar boxsize2))
                                  (_box (cadr boxsize)(car boxsize2) nil)
                    (_box (car boxsize)(cadr boxsize2) nil))
  )

[/color][/b]

Edited April 29, 2012 by pBe