LISP to calculate the minimum possible WIDTH of selected objects?

[lamensterms]

Hi guys,

 

Another 'boundary generate' question - possibly with a bit of a twist.

 

I am looking for a routine that will generate a boundary that has the minimum possible width of the selected objects.  Please see sketch below and attached DWG for example.

 

I am not trying to generate the smallest possible boundary (like Lee's routine here), rather I am trying to create the narrowest possible boundary.  For example, to work out if a load is too wide to fit on a truck trailer.

 

Anyone know of a LISP routine that will perform this?

 

Thanks for any help

 

_Narrow.dwg

[BIGAL]

Maybe Like Lee a brute force rotate the objects through 180 and get bounding box looking at length and width. As per your right hand image but rotated.

 

Try a random rotation of your objects approx. 45 and run lee's bounding program can get the length of the pline sides. I think if its ortho does not work for your answer. 

 

 

Edited February 12, 2020 by BIGAL

[Lee Mac]

You could use the same method as used by my program, but instead of using the bounding box area to as the comparison metric, use the minimum of the length of two adjacent sides. For example, in my code, change these lines:

bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))

...

bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))

To:

bx1 (min (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))

...

bx2 (min (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))

 

Edited February 12, 2020 by Lee Mac

[lamensterms]

Thanks for the replies guys.

 

@Lee - I have made the changes to your code, done a bit of testing an have found that sometimes it will generate the narrowest possible boundary, and sometimes not.

 

It appears to be affected by the rotation/orientation of the elements.  Please see attached DWG and sketch below for example.

 

Any suggestions to optimise the boundary generation any further?

 

Thanks again for your help 

 

Code I've used:

(defun LM:narboundingbox ( sel tol / ang box bx1 bx2 cen idx lst obj rtn )
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                          bx1 (min (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (min (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                           '(
                                (caar   cadar)
                                (caadr  cadar)
                                (caadr cadadr)
                                (caar  cadadr)
                            )
                        )
                        cen (- (car rtn))
                    )
                )
            )
        )
    )
)
                                   
(defun c:bbnar ( / sel )
    (if (setq sel (ssget "_:L"))
        (entmake
            (append
               '(
                    (000 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (100 . "AcDbPolyline")
                    (090 . 4)
                    (070 . 1)
                )
                (mapcar '(lambda ( p ) (cons 10 p)) (LM:narboundingbox sel 0.01))
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

_Narrow.dwg

[Lee Mac]

14 hours ago, lamensterms said:

@Lee - I have made the changes to your code, done a bit of testing an have found that sometimes it will generate the narrowest possible boundary, and sometimes not.

 

It appears to be affected by the rotation/orientation of the elements.  Please see attached DWG and sketch below for example.

 

Any suggestions to optimise the boundary generation any further?

 

Bear in mind that the method implemented by my Minimum Bounding Box function is an iterative approximation: the set of objects are incrementally rotated by an angle determined by the supplied precision parameter (in your case 0.01); reducing the magnitude of the precision parameter will cause the result to tend toward the true minimum bounding box - though of course, at the sacrifice of performance.

 

As such, if you require a more accuracy in the bounding box, try increasing the precision by an order of magnitude, e.g.:

(LM:narboundingbox sel 0.001)

 

[lamensterms]

Awesome, thanks so much for the reply Lee.

 

I've reduced the rotation precision parameter and the results are sooooo close to spot on.  As you suggest, I could go further and keep reducing the rotation precision, but the performance trade-off may not always be worth it (if the difference is only a few mm).

 

Definitely a great result for the intended application.

 

Thanks again Lee and everyone for your help.