MSasu Posted April 28, 2012 Share Posted April 28, 2012 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: Quote Link to comment Share on other sites More sharing options...
pBe Posted April 29, 2012 Share Posted April 29, 2012 (edited) 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 Quote Link to comment Share on other sites More sharing options...
MSasu Posted April 29, 2012 Share Posted April 29, 2012 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? Quote Link to comment Share on other sites More sharing options...
pBe Posted April 29, 2012 Share Posted April 29, 2012 (edited) 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 Quote Link to comment Share on other sites More sharing options...
MSasu Posted April 29, 2012 Share Posted April 29, 2012 Oauu, what a speed! Only if I got such support from other software suppliers... Quote Link to comment Share on other sites More sharing options...
pBe Posted April 29, 2012 Share Posted April 29, 2012 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.